1 USING: accessors combinators continuations http http.parsers io
2 io.crlf io.encodings io.encodings.binary io.streams.limited
3 kernel math.order math.parser namespaces sequences splitting
5 FROM: mime.multipart => parse-multipart ;
6 IN: http.server.requests
10 ERROR: no-boundary < request-error ;
12 ERROR: invalid-path < request-error path ;
14 ERROR: invalid-content-length < request-error content-length ;
16 ERROR: content-length-missing < request-error ;
18 ERROR: bad-request-line < request-error parse-error ;
20 : check-absolute ( url -- )
21 path>> dup "/" head? [ drop ] [ invalid-path ] if ; inline
23 : parse-request-line-safe ( string -- triple )
24 [ parse-request-line ] [ nip bad-request-line ] recover ;
26 : read-request-line ( request -- request )
27 read-?crlf [ dup "" = ] [ drop read-?crlf ] while
28 parse-request-line-safe first3
29 [ >>method ] [ >url dup check-absolute >>url ] [ >>version ] tri* ;
31 : read-request-header ( request -- request )
32 read-header >>header ;
36 upload-limit [ 200,000,000 ] initialize
38 : parse-multipart-form-data ( string -- separator )
40 "=" split1 nip [ no-boundary ] unless* ;
42 : maybe-limit-input ( content-length -- )
43 unlimited-input upload-limit get [ min ] when* limited-input ;
45 : read-multipart-data ( request content-length -- mime-parts )
46 maybe-limit-input binary decode-input
47 "content-type" header parse-multipart-form-data parse-multipart ;
49 : parse-content-length-safe ( request -- content-length )
50 "content-length" header [
52 dup 0 upload-limit get between? [
53 invalid-content-length
55 ] [ invalid-content-length ] if
56 ] [ content-length-missing ] if* ;
58 : parse-content ( request content-type -- post-data )
59 dup <post-data> -rot over parse-content-length-safe swap
61 { "multipart/form-data" [ read-multipart-data >>params ] }
62 { "application/x-www-form-urlencoded" [
63 nip read query>assoc >>params
65 [ drop nip read >>data ]
68 : read-post-data ( request -- request )
69 dup method>> "POST" = [
70 dup dup "content-type" header
71 ";" split1 drop parse-content >>post-data
74 : extract-host ( request -- request )
75 [ ] [ url>> ] [ "host" header parse-host ] tri
76 [ >>host ] [ >>port ] bi*
79 : extract-cookies ( request -- request )
80 dup "cookie" header [ parse-cookie >>cookies ] when* ;
82 : read-request ( -- request )