1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
(define-module (webserver-utils)
#:use-module (rnrs bytevectors)
#:use-module (web server)
#:use-module (web request)
#:use-module (web response)
#:use-module (web uri)
#:use-module (sxml simple)
#:export (redirect
not-found
request-header-for-name
request-query-for-name
post-query-for-name
request-path-components
request-query-components
request-ip))
(define (redirect url)
"TODO: send location header for 301 insetead of html refresh header"
(values (build-response
#:code 301
#:headers `((content-type . (text/html (charset . "utf-8")))
;; (location . (url))
))
;; ""
(lambda (port)
(display "<!DOCTYPE html>\n" port)
(sxml->xml `(meta (@ (http-equiv "refresh")
(content (string-append "0; url="
,url))))
port))))
(define (request-path-components request)
(split-and-decode-uri-path (uri-path (request-uri request))))
(define (split-and-decode-uri-query query)
"Split QUERY into its components, and decode each component,
removing empty components.
Example: ?hello=world&other=value&single
=> ((\"hello\" \"world\") (\"other\" \"value\") (\"single\"))"
(filter (lambda (x) (not (null? x)))
(map (lambda (x)
(filter (lambda (x) (not (string-null? x)))
(map uri-decode (string-split x #\=))))
(string-split query #\&))))
(define (request-query-components request)
(define query-string (uri-query (request-uri request)))
(if query-string
(split-and-decode-uri-query query-string)
'()))
(define (not-found request)
(values (build-response #:code 404)
(string-append "Resource not found: "
(uri->string (request-uri request)))))
(define (request-query-for-name request name)
(define request-query (or (request-query-components request) '()))
(define queries (or (assoc-ref request-query name) '()))
(define query (if (null? queries) #f (uri-decode (car queries))))
query)
(define (post-query-for-name body name)
(define body-string (or (and body (if (string? body)
body
(utf8->string body)))
""))
(define post-query (or (split-and-decode-uri-query body-string) '()))
(define queries (or (assoc-ref post-query name) '()))
(define query (if (null? queries) #f (uri-decode (car queries))))
query)
(define (request-header-for-name request name)
(define headers (or (request-headers request) '()))
(define value (or (assoc-ref headers name) '()))
value)
(define (request-ip request)
(request-header-for-name request 'x-real-ip))