WebGate

Check-in [362eecda51]
Login

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

Overview
Comment:Support for REMOTE_ADDR and REMOTE_PORT in the soup adapter
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1:362eecda51c2aef842a8950242b4d66f9cf7f86c
User & Date: murphy 2015-05-04 11:11:08
Context
2015-05-04
12:19
Improved listener configuration, HTTP_ prefix for soup header variables check-in: 8e0d0801c6 user: murphy tags: trunk
11:11
Support for REMOTE_ADDR and REMOTE_PORT in the soup adapter check-in: 362eecda51 user: murphy tags: trunk
10:39
Allow WebGate to work with the standard suspension egg check-in: d11a75d327 user: murphy tags: trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Changes to webgate-soup.scm.

38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
..
59
60
61
62
63
64
65











66
67
68
69
70
71
72
...
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120




121
122
123
124
125
					((c-pointer "SoupMessage") message)
					((const c-string) path)
					((c-pointer "GHashTable") query)
					((c-pointer "SoupClientContext") client)
					(c-pointer root)) void
  (((foreign-lambda scheme-object "CHICKEN_gc_root_ref" nonnull-c-pointer)
    root)
   server message path))

(define soup-server-add-handler
  (foreign-lambda* void (((nonnull-c-pointer "SoupServer") server)
			 (c-string path)
			 (scheme-object proc))
    "void *root = CHICKEN_new_gc_root();\n"
    "CHICKEN_gc_root_set(root, proc);\n"
................................................................................
  (foreign-lambda* c-string (((nonnull-c-pointer "SoupMessage") message))
    "C_return(message->method);"))

(define soup-message-query
  (foreign-lambda* c-string (((nonnull-c-pointer "SoupMessage") message))
    "C_return(soup_uri_get_query(soup_message_get_uri(message)));"))












(define soup-request-header-ref
  (foreign-lambda* c-string (((nonnull-c-pointer "SoupMessage") message)
			     (nonnull-c-string name))
    "C_return(soup_message_headers_get_list(message->request_headers, name));"))

(define soup-request-body
  (foreign-primitive scheme-object (((nonnull-c-pointer "SoupMessage") message))
................................................................................

;; soup server loop

(define (soup-main-loop handle-request port)
  (let ((server (soup-server-new port)))
    (soup-server-add-handler
     server #f
     (lambda (server message path)
       (handle-request
        (lambda (name)
          (cond
           ((string=? name "REQUEST_METHOD")
            (soup-message-method message))
           ((string=? name "PATH_INFO")
            path)
           ((string=? name "QUERY_STRING")
            (soup-message-query message))




           (else
            (soup-request-header-ref message (string-translate name #\_ #\-)))))
        (open-input-string (soup-request-body message))
        (cut soup-response-set! message <>))))
    (soup-server-run server)))







|







 







>
>
>
>
>
>
>
>
>
>
>







 







|









>
>
>
>





38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
..
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
...
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
					((c-pointer "SoupMessage") message)
					((const c-string) path)
					((c-pointer "GHashTable") query)
					((c-pointer "SoupClientContext") client)
					(c-pointer root)) void
  (((foreign-lambda scheme-object "CHICKEN_gc_root_ref" nonnull-c-pointer)
    root)
   server client message path))

(define soup-server-add-handler
  (foreign-lambda* void (((nonnull-c-pointer "SoupServer") server)
			 (c-string path)
			 (scheme-object proc))
    "void *root = CHICKEN_new_gc_root();\n"
    "CHICKEN_gc_root_set(root, proc);\n"
................................................................................
  (foreign-lambda* c-string (((nonnull-c-pointer "SoupMessage") message))
    "C_return(message->method);"))

(define soup-message-query
  (foreign-lambda* c-string (((nonnull-c-pointer "SoupMessage") message))
    "C_return(soup_uri_get_query(soup_message_get_uri(message)));"))

(define soup-client-address
  (foreign-lambda c-string "soup_client_context_get_host" (nonnull-c-pointer "SoupClientContext")))

(define soup-client-port
  (foreign-lambda* scheme-object (((nonnull-c-pointer "SoupClientContext") client))
    "SoupAddress *address;\n"
    "gint port;"
    "if (!(address = soup_client_context_get_address(client))) C_return(C_SCHEME_FALSE);\n"
    "if ((port = soup_address_get_port(address)) < 0) C_return(C_SCHEME_FALSE);\n"
    "C_return(C_fix(port));"))

(define soup-request-header-ref
  (foreign-lambda* c-string (((nonnull-c-pointer "SoupMessage") message)
			     (nonnull-c-string name))
    "C_return(soup_message_headers_get_list(message->request_headers, name));"))

(define soup-request-body
  (foreign-primitive scheme-object (((nonnull-c-pointer "SoupMessage") message))
................................................................................

;; soup server loop

(define (soup-main-loop handle-request port)
  (let ((server (soup-server-new port)))
    (soup-server-add-handler
     server #f
     (lambda (server client message path)
       (handle-request
        (lambda (name)
          (cond
           ((string=? name "REQUEST_METHOD")
            (soup-message-method message))
           ((string=? name "PATH_INFO")
            path)
           ((string=? name "QUERY_STRING")
            (soup-message-query message))
	   ((or (string=? name "REMOTE_ADDR") (string=? name "REMOTE_HOST"))
	    (soup-client-address client))
	   ((string=? name "REMOTE_PORT")
	    (cond ((soup-client-port client) => number->string) (else #f)))
           (else
            (soup-request-header-ref message (string-translate name #\_ #\-)))))
        (open-input-string (soup-request-body message))
        (cut soup-response-set! message <>))))
    (soup-server-run server)))