1:
2:
3:
4:
5: (use gauche.test)
6: (use gauche.parameter)
7: (use gauche.charconv)
8: (use text.tree)
9: (use rfc.822)
10: (use file.util)
11: (test-start "www.* modules")
12:
13:
14: (test-section "www.cgi")
15: (use www.cgi)
16: (test-module 'www.cgi)
17:
18: (define params #f)
19: (define qs1 "a=foo+bar&boo=baz=doo&z%3Dz=%21%26&a=+%20&#=#&z=z=8&r&r=2")
20: (define qr1 '(("boo" "baz=doo") ("z=z" "!&") ("a" "foo bar" " ") ("#" "#") ("z" "z=8") ("r" #t "2")))
21: (define qs1b "a=foo+bar;boo=baz=doo;z%3Dz=%21%26;a=+%20;#=#;z=z=8;r;r=2")
22:
23: (define qs2 "zz=aa&aa=zz")
24: (define qr2 '(("zz" "aa") ("aa" "zz")))
25:
26: (test* "cgi-parse-parameters" qr1
27: (cgi-parse-parameters :query-string qs1))
28: (test* "cgi-parse-parameters" qr1
29: (cgi-parse-parameters :query-string qs1b))
30:
31: (define ps1 "--boundary
32: Content-Disposition: form-data; name=\"aaa\"
33:
34: 111
35: --boundary
36: Content-Disposition: form-data; name=\"bbb\"; filename=\"x.txt\"
37: Content-Type: text/plain
38:
39: abc
40: def
41: ghi
42:
43: --boundary
44: Content-Disposition: form-data; name=\"ccc\"; filename=\"\"
45:
46: --boundary
47: Content-Disposition: form-data: name=\"ddd\"; filename=\"ttt\\bbb\"
48: Content-Type: application/octet-stream
49: Content-Transfer-Encoding: base64
50:
51: VGhpcyBpcyBhIHRlc3Qgc2VudGVuY2Uu
52: --boundary--
53: ")
54:
55: (define pr1 '(("aaa" "111") ("bbb" "abc\ndef\nghi\n") ("ccc" #f) ("ddd" "This is a test sentence.")))
56:
57: (define pr2 '(("aaa" "111") ("bbb" "x.txt") ("ccc" #f) ("ddd" "ttt\\bbb")))
58:
59: (test* "cgi-parse-parameters (multipart)" pr1
60: (parameterize ((cgi-metavariables `(("REQUEST_METHOD" "POST")
61: ("CONTENT_TYPE" "multipart/form-data; boundary=boundary")
62: ("CONTENT_LENGTH" ,(string-size ps1)))))
63: (with-input-from-string ps1
64: (lambda () (cgi-parse-parameters)))))
65:
66: (test* "cgi-parse-parameters (multipart, custom handler)" pr2
67: (parameterize ((cgi-metavariables `(("REQUEST_METHOD" "POST")
68: ("CONTENT_TYPE" "multipart/form-data; boundary=boundary")
69: ("CONTENT_LENGTH" ,(string-size ps1)))))
70: (with-input-from-string ps1
71: (lambda ()
72: (cgi-parse-parameters
73: :part-handlers
74: `((#t ,(lambda (name filename info inp)
75: (let loop ((line (read-line inp)))
76: (if (eof-object? line)
77: filename
78: (loop (read-line inp))))))))))
79: ))
80:
81: (test* "cgi-parse-parameters (multipart, custom handler 2)" "abc\ndef\nghi\n"
82: (parameterize ((cgi-metavariables `(("REQUEST_METHOD" "POST")
83: ("CONTENT_TYPE" "multipart/form-data; boundary=boundary")
84: ("CONTENT_LENGTH" ,(string-size ps1)))))
85: (let1 r
86: (with-input-from-string ps1
87: (lambda ()
88: (cgi-parse-parameters
89: :part-handlers `(("bbb" file :prefix "./bbb")))))
90: (let* ((tmpfile (cgi-get-parameter "bbb" r))
91: (content (file->string tmpfile)))
92: (sys-unlink tmpfile)
93: content))))
94:
95: (test* "cgi-parse-parameters (multipart, custom handler 3)" "abc\ndef\nghi\n"
96: (parameterize ((cgi-metavariables `(("REQUEST_METHOD" "POST")
97: ("CONTENT_TYPE" "multipart/form-data; boundary=boundary")
98: ("CONTENT_LENGTH" ,(string-size ps1)))))
99: (let1 r
100: (with-input-from-string ps1
101: (lambda ()
102: (cgi-parse-parameters
103: :part-handlers `((#/b{3}/ file :prefix "./bbb")))))
104: (let* ((tmpfile (cgi-get-parameter "bbb" r))
105: (content (file->string tmpfile)))
106: (sys-unlink tmpfile)
107: content))))
108:
109: (test* "cgi-get-parameter" "foo bar"
110: (cgi-get-parameter "a" qr1))
111: (test* "cgi-get-parameter" '("foo bar" " ")
112: (cgi-get-parameter "a" qr1 :list #t))
113: (test* "cgi-get-parameter" #t
114: (cgi-get-parameter "r" qr1))
115: (test* "cgi-get-parameter" '(#t "2")
116: (cgi-get-parameter "r" qr1 :list #t))
117: (test* "cgi-get-parameter" '("baz=doo")
118: (cgi-get-parameter "boo" qr1 :list #t))
119: (test* "cgi-get-parameter" 'none
120: (cgi-get-parameter "booz" qr1 :default 'none))
121: (test* "cgi-get-parameter" #f
122: (cgi-get-parameter "booz" qr1))
123: (test* "cgi-get-parameter" '()
124: (cgi-get-parameter "booz" qr1 :list #t))
125: (test* "cgi-get-parameter" '(0 2)
126: (cgi-get-parameter "r" qr1 :convert x->integer :list #t))
127:
128: (test* "cgi-get-query (GET)" qr1
129: (parameterize ((cgi-metavariables `(("REQUEST_METHOD" "GET")
130: ("QUERY_STRING" ,qs1))))
131: (with-input-from-string qs2
132: cgi-parse-parameters)))
133: (test* "cgi-get-query (HEAD)" qr1
134: (parameterize ((cgi-metavariables `(("REQUEST_METHOD" "HEAD")
135: ("QUERY_STRING" ,qs1))))
136: (with-input-from-string qs2
137: cgi-parse-parameters)))
138: (test* "cgi-get-query (POST)" qr2
139: (parameterize ((cgi-metavariables `(("REQUEST_METHOD" "POST")
140: ("QUERY_STRING" ,qs1))))
141: (with-input-from-string qs2
142: cgi-parse-parameters)))
143: (test* "cgi-get-query (POST)" qr2
144: (parameterize ((cgi-metavariables `(("REQUEST_METHOD" "POST")
145: ("CONTENT_LENGTH" ,(string-length qs2)))))
146: (with-input-from-string qs2
147: cgi-parse-parameters)))
148: (test* "cgi-get-query (POST)" '(("zz" "aa"))
149: (parameterize ((cgi-metavariables `(("REQUEST_METHOD" "POST")
150: ("CONTENT_LENGTH" 5))))
151: (with-input-from-string qs2
152: cgi-parse-parameters)))
153:
154: (test* "cgi-header" "Content-type: text/html\r\n\r\n"
155: (tree->string (cgi-header)))
156:
157: (test* "cgi-header" "Location: http://foo.bar/\r\n\r\n"
158: (tree->string (cgi-header :location "http://foo.bar/")))
159:
160: (test* "cgi-header" "Content-type: hoge\r\nLocation: http://foo.bar/\r\n\r\n"
161: (tree->string
162: (cgi-header :location "http://foo.bar/" :content-type "hoge")))
163:
164: (test* "cgi-header" "Content-type: text/plain; charset=utf-8\r\n\r\n"
165: (tree->string
166: (cgi-header :content-type "text/plain; charset=utf-8")))
167:
168: (test* "cgi-header"
169: "Content-type: text/html\r\nSet-cookie: hoge\r\nSet-cookie: poge\r\n\r\n"
170: (tree->string
171: (cgi-header :cookies '("hoge" "poge"))))
172:
173: (test* "cgi-header"
174: "Content-type: text/html\r\nSet-cookie: hoge\r\nSet-cookie: poge\r\nx-foo: foo\r\n\r\n"
175: (tree->string
176: (cgi-header :x-foo "foo" :cookies '("hoge" "poge"))))
177:
178: (test* "cgi-main" "Content-type: text/plain\r\n\r\na=foo bar"
179: (parameterize ((cgi-metavariables `(("REQUEST_METHOD" "GET")
180: ("QUERY_STRING" ,qs1))))
181: (with-output-to-string
182: (lambda ()
183: (cgi-main
184: (lambda (params)
185: `(,(cgi-header :content-type "text/plain")
186: "a="
187: ,(cgi-get-parameter "a" params))))))))
188:
189: (unless (eq? (gauche-character-encoding) 'none)
190: (test* "cgi-output-character-encoding" #*"\xe3\x81\x82"
191: (string-complete->incomplete
192: (parameterize ((cgi-metavariables `(("REQUEST_METHOD" "GET")
193: ("QUERY_STRING" "")))
194: (cgi-output-character-encoding 'utf8))
195: (with-output-to-string
196: (lambda ()
197: (cgi-main
198: (lambda (params)
199: (string #\u3042)))))))))
200:
201:
202: (test-section "www.cgi.test")
203: (use www.cgi.test)
204: (test-module 'www.cgi.test)
205:
206: (test* "cgi-test-environment-ref" "remote"
207: (cgi-test-environment-ref "REMOTE_HOST"))
208: (test* "cgi-test-environment-ref" "zzz"
209: (cgi-test-environment-ref 'ZZZ "zzz"))
210: (test* "cgi-test-environment-set!" "foo.com"
211: (begin
212: (set! (cgi-test-environment-ref 'REMOTE_HOST) "foo.com")
213: (cgi-test-environment-ref "REMOTE_HOST")))
214:
215: (sys-system "rm -rf test.o")
216: (sys-mkdir "test.o" #o755)
217:
218: (with-output-to-file "test.o/cgitest.cgi"
219: (lambda ()
220: (print "#!/bin/sh")
221: (print "echo Content-type: text/plain")
222: (print "echo")
223: (print "echo \"SERVER_NAME = $SERVER_NAME\"")
224: (print "echo \"REMOTE_HOST = $REMOTE_HOST\"")
225: (print "echo \"REQUEST_METHOD = $REQUEST_METHOD\"")
226: (print "echo \"CONTENT_TYPE = $CONTENT_TYPE\"")
227: (print "echo \"QUERY_STRING = $QUERY_STRING\"")))
228:
229: (sys-chmod "test.o/cgitest.cgi" #o755)
230:
231: (test* "call-with-cgi-script" '(("content-type" "text/plain"))
232: (call-with-cgi-script "test.o/cgitest.cgi"
233: (lambda (p)
234: (rfc822-header->list p)))
235: )
236:
237: (test* "run-cgi-script->string-list"
238: '((("content-type" "text/plain"))
239: ("SERVER_NAME = localhost"
240: "REMOTE_HOST = foo.com"
241: "REQUEST_METHOD = GET"
242: "CONTENT_TYPE = "
243: "QUERY_STRING = "))
244: (receive r (run-cgi-script->string-list "test.o/cgitest.cgi")
245: r)
246: )
247:
248: (test* "run-cgi-script->string-list (using parameters/GET)"
249: '("SERVER_NAME = localhost"
250: "REMOTE_HOST = foo.com"
251: "REQUEST_METHOD = GET"
252: "CONTENT_TYPE = "
253: "QUERY_STRING = a=b&%26%26%24%26=%21%40%21%40")
254: (receive (_ body)
255: (run-cgi-script->string-list "test.o/cgitest.cgi"
256: :parameters '((a . b) (&&$& . !@!@)))
257: body))
258:
259: (test* "run-cgi-script->string-list (using parameters/HEAD)"
260: '("SERVER_NAME = localhost"
261: "REMOTE_HOST = foo.com"
262: "REQUEST_METHOD = HEAD"
263: "CONTENT_TYPE = "
264: "QUERY_STRING = a=b&%26%26%24%26=%21%40%21%40")
265: (receive (_ body)
266: (run-cgi-script->string-list "test.o/cgitest.cgi"
267: :environment '((REQUEST_METHOD . HEAD))
268: :parameters '((a . b) (&&$& . !@!@)))
269: body))
270:
271: (with-output-to-file "test.o/cgitest.cgi"
272: (lambda ()
273: (print "#!/bin/sh")
274: (print "echo Content-type: text/plain")
275: (print "echo")
276: (print "echo \"REQUEST_METHOD = $REQUEST_METHOD\"")
277: (print "echo \"CONTENT_TYPE = $CONTENT_TYPE\"")
278: (print "echo \"CONTENT_LENGTH = $CONTENT_LENGTH\"")
279: (print "echo \"QUERY_STRING = $QUERY_STRING\"")
280: (print "cat")))
281:
282: (test* "run-cgi-script->string-list (using parameters)"
283: '("REQUEST_METHOD = POST"
284: "CONTENT_TYPE = application/x-www-form-urlencoded"
285: "CONTENT_LENGTH = 29"
286: "QUERY_STRING = "
287: "a=b&%26%26%24%26=%21%40%21%40")
288: (receive (_ body)
289: (run-cgi-script->string-list "test.o/cgitest.cgi"
290: :environment '((REQUEST_METHOD . POST))
291: :parameters '((a . b) (&&$& . !@!@)))
292: body))
293:
294: (sys-system "rm -rf test.o")
295:
296:
297: (test-end)
298:
299:
