WebGate

Check-in [22158254d8]
Login

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

Overview
Comment:Clean up tcp listener in webgate-main using dynamic wind
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: 22158254d84b0d464018856fc70487fe0c3fa1a6
User & Date: murphy 2013-05-31 23:14:11
Context
2013-06-02
15:19
The parameters table should not be part of the serialization context check-in: 853b10e568 user: murphy tags: trunk
2013-05-31
23:14
Clean up tcp listener in webgate-main using dynamic wind check-in: 22158254d8 user: murphy tags: trunk
12:37
More consistent signature for make-redirect-response check-in: bc50958c55 user: murphy tags: trunk
Changes
Hide Diffs Side-by-Side Diffs Ignore Whitespace Patch

Changes to webgate.scm.

    64     64      resource-context current-resource-context resource-context?
    65     65      resource-context-getenv resource-context-method resource-context-path
    66     66      response make-response response?
    67     67      collect-response make-html-response make-error-response
    68     68      make-redirect-response
    69     69      response-status response-status-message
    70     70      write-response
    71         -   resource-handler define-resource resource-uri
           71  +   resource-handler resource-uri
           72  +   (define-resource resource-handler extend-procedure procedure-data)
    72     73      handle-query-parameters
    73     74      handle-request)
    74     75     (import
    75     76      scheme chicken
    76     77      srfi-1 srfi-4 srfi-13 srfi-18 srfi-69 srfi-99
    77     78      data-structures ports extras lolevel irregex
    78     79      protobuf-generic suspension webgate-utils)
................................................................................
   104    105      scheme chicken
   105    106      srfi-13 srfi-18 srfi-69
   106    107      data-structures irregex webgate-utils tcp)
   107    108     (include
   108    109      "webgate-scgi.scm"))
   109    110   
   110    111   (module webgate
   111         -  (message make-message message?
   112         -   message-type message-headers message-body message-text
   113         -   parameter-list-ref parameter-ref
   114         -   resource-context current-resource-context resource-context?
   115         -   resource-context-getenv resource-context-method resource-context-path
   116         -   response make-response response?
   117         -   collect-response make-html-response make-error-response
   118         -   make-redirect-response
   119         -   response-status response-status-message
   120         -   resource-handler define-resource resource-uri
   121         -   send/suspend
   122         -   webgate-main)
          112  +  (webgate-main)
   123    113     (import
   124    114      scheme chicken
   125         -   srfi-13 webgate-core webgate-suspend webgate-cgi webgate-scgi tcp)
          115  +   srfi-13 webgate-cgi webgate-scgi tcp
          116  +   (only webgate-core
          117  +	 handle-request)
          118  +   (only webgate-suspend
          119  +	 current-suspension-key))
          120  +  (reexport
          121  +   (only webgate-core
          122  +	 message make-message message?
          123  +	 message-type message-headers message-body message-text
          124  +	 parameter-list-ref parameter-ref
          125  +	 resource-context current-resource-context resource-context?
          126  +	 resource-context-getenv resource-context-method resource-context-path
          127  +	 response make-response response?
          128  +	 collect-response make-html-response make-error-response
          129  +	 make-redirect-response
          130  +	 response-status response-status-message
          131  +	 define-resource resource-uri)
          132  +   (only webgate-suspend 
          133  +	 send/suspend))
   126    134   
   127    135   (define (webgate-main #!optional (arguments (command-line-arguments)))
   128    136     (apply
   129    137      (lambda (#!key port (backlog 4) (host "localhost") (suspension-key #f))
   130    138        (cond
   131    139         (suspension-key => current-suspension-key))
   132    140        (if port
   133         -	 (scgi-main-loop handle-request (tcp-listen port backlog host))
          141  +	 (let ((ear (tcp-listen port backlog host)))
          142  +	   (dynamic-wind
          143  +	       void
          144  +	       (cut scgi-main-loop handle-request ear)
          145  +	       (cut tcp-close ear)))
   134    146   	 (cgi-main-loop handle-request)))
   135    147      (map
   136    148       (lambda (arg)
   137    149         (if (string-prefix? "-" arg)
   138    150   	  (string->keyword (substring/shared arg 1))
   139    151   	  (or (string->number arg) arg)))
   140    152       arguments)))
   141    153   
   142    154   )