Check-in [04a3625e95]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:added scgi-before-fork-hook
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:04a3625e95557e77db665fc5e32a3f7e60bf4c4d
User & Date: aldo 2018-12-09 15:17:28
Context
2018-12-09
15:18
improved nn-recv check-in: 791b935228 user: aldo tags: trunk
15:17
added scgi-before-fork-hook check-in: 04a3625e95 user: aldo tags: trunk
15:17
added sqlite3-config-log and sqlite3-busy-timeout check-in: 73c6d80c36 user: aldo tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to scgi.sls.

11
12
13
14
15
16
17
18

19
20
21
22
23
24
25
..
43
44
45
46
47
48
49


50
51
52
53
54
55
56
..
58
59
60
61
62
63
64
65

66
67

68
69
70
71
72
73
74
..
81
82
83
84
85
86
87

88
89
90
91
92
93
94
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(library (scgi)
  (export scgi-request-handler handle-scgi-connection run-scgi
	  scgi-headers->bytevector)

  (import (chezscheme)
	  (socket)
	  (netstring)
	  (only (srfi s1 lists) list-index take drop)
	  (only (posix) fork wait-for-pid wait-flag))

  (define (header-get-token l)
................................................................................
	   (fold-right
	    (lambda (x acc)
	      (let ([name (car x)] [value (cdr x)])
		(append (bytevector->u8-list (string->utf8 name)) '(0)
			(bytevector->u8-list (string->utf8 value)) '(0)
			acc)))
	    '() l )))



  (define scgi-request-handler
    (make-parameter
     (lambda (response-port headers content)
       (printf "scgi: headers: ~a~n" headers)
       (printf "scgi: contents: ~a~n" content)
       
................................................................................
  
  (define (handle-scgi-connection sock)
    (define h (read-headers sock))
    (assert (string=? "1" (cdr (assq 'SCGI h))))
    (let* ([len (string->number (cdr (assq 'CONTENT_LENGTH h)))]
	   [content (get-bytevector-n sock len)])
      (assert (= (bytevector-length content) len))
      (let ([port (transcoded-port sock (make-transcoder (utf-8-codec) 'none))])

	((scgi-request-handler) port h content)
	(flush-output-port port))))


  (define (run-scgi addr port)
    (define nchildren 0)
    (define max-children 10)
    (define waitpid (foreign-procedure "waitpid" (int void* int) int))
    (call-with-port
     (socket 'inet 'stream '() 0)
................................................................................
	 (printf "scgi: waiting for connection...~n")
	 (call-with-port
	  (accept sock)
	  (lambda (clifd)
	    (printf "scgi: accepted connection~n")
	    (if (> nchildren max-children)
		(sleep (make-time 'time-duration 0 1)))

	    (printf "scgi: forking..~n")
	    (let ([pid (fork)])
	      (cond
	       [(= pid 0)
		(guard (e [else (display "scgi: handler error: ")
				  (display-condition e)
				  (newline)])			   







|
>







 







>
>







 







|
>

|
>







 







>







11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
..
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
..
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
..
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
;; distributed under the License is distributed on an "AS IS" BASIS,
;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;; See the License for the specific language governing permissions and
;; limitations under the License.

(library (scgi)
  (export scgi-request-handler handle-scgi-connection run-scgi
	  scgi-headers->bytevector
	  scgi-before-fork-hook)
  (import (chezscheme)
	  (socket)
	  (netstring)
	  (only (srfi s1 lists) list-index take drop)
	  (only (posix) fork wait-for-pid wait-flag))

  (define (header-get-token l)
................................................................................
	   (fold-right
	    (lambda (x acc)
	      (let ([name (car x)] [value (cdr x)])
		(append (bytevector->u8-list (string->utf8 name)) '(0)
			(bytevector->u8-list (string->utf8 value)) '(0)
			acc)))
	    '() l )))
  
  (define scgi-before-fork-hook (make-parameter values))

  (define scgi-request-handler
    (make-parameter
     (lambda (response-port headers content)
       (printf "scgi: headers: ~a~n" headers)
       (printf "scgi: contents: ~a~n" content)
       
................................................................................
  
  (define (handle-scgi-connection sock)
    (define h (read-headers sock))
    (assert (string=? "1" (cdr (assq 'SCGI h))))
    (let* ([len (string->number (cdr (assq 'CONTENT_LENGTH h)))]
	   [content (get-bytevector-n sock len)])
      (assert (= (bytevector-length content) len))
      ;;(let ([port (transcoded-port sock (make-transcoder (utf-8-codec) 'none))])
      (let ([port sock])
	((scgi-request-handler) port h content)
	#;(flush-output-port port)
	#;(close-port port))))

  (define (run-scgi addr port)
    (define nchildren 0)
    (define max-children 10)
    (define waitpid (foreign-procedure "waitpid" (int void* int) int))
    (call-with-port
     (socket 'inet 'stream '() 0)
................................................................................
	 (printf "scgi: waiting for connection...~n")
	 (call-with-port
	  (accept sock)
	  (lambda (clifd)
	    (printf "scgi: accepted connection~n")
	    (if (> nchildren max-children)
		(sleep (make-time 'time-duration 0 1)))
	    ((scgi-before-fork-hook))
	    (printf "scgi: forking..~n")
	    (let ([pid (fork)])
	      (cond
	       [(= pid 0)
		(guard (e [else (display "scgi: handler error: ")
				  (display-condition e)
				  (newline)])