1 USING: accessors combinators continuations http http.parsers io io.crlf
2 io.encodings io.encodings.binary io.streams.limited kernel math math.order
3 math.parser namespaces sequences splitting urls urls.encoding ;
4 FROM: mime.multipart => parse-multipart ;
5 IN: http.server.requests
9 ERROR: no-boundary < request-error ;
11 ERROR: invalid-path < request-error path ;
13 ERROR: invalid-content-length < request-error content-length ;
15 ERROR: content-length-missing < request-error ;
17 ERROR: bad-request-line < request-error parse-error ;
19 : check-absolute ( url -- )
20 path>> dup "/" head? [ drop ] [ invalid-path ] if ; inline
22 : parse-request-line-safe ( string -- triple )
23 [ parse-request-line ] [ nip bad-request-line ] recover ;
25 : read-request-line ( request -- request )
26 read-?crlf [ dup "" = ] [ drop read-?crlf ] while
27 parse-request-line-safe first3
28 [ >>method ] [ >url dup check-absolute >>url ] [ >>version ] tri* ;
30 : read-request-header ( request -- request )
31 read-header >>header ;
35 upload-limit [ 200,000,000 ] initialize
37 : parse-multipart-form-data ( string -- separator )
39 "=" split1 nip [ no-boundary ] unless* ;
41 : maybe-limit-input ( content-length -- )
42 unlimited-input upload-limit get [ min ] when* limited-input ;
44 : read-multipart-data ( request content-length -- mime-parts )
45 maybe-limit-input binary decode-input
46 "content-type" header parse-multipart-form-data parse-multipart ;
48 : parse-content-length-safe ( request -- content-length )
49 "content-length" header [
51 nip dup 0 upload-limit get between? [
52 invalid-content-length
54 ] [ invalid-content-length ] if*
55 ] [ content-length-missing ] if* ;
57 : parse-content ( request content-type -- post-data )
58 dup <post-data> -rot over parse-content-length-safe swap
60 { "multipart/form-data" [ read-multipart-data >>params ] }
61 { "application/x-www-form-urlencoded" [
62 nip read query>assoc >>params
64 [ drop nip read >>data ]
67 : read-post-data ( request -- request )
68 dup method>> "POST" = [
69 dup dup "content-type" header
70 ";" split1 drop parse-content >>post-data
73 : extract-host ( request -- request )
74 [ ] [ url>> ] [ "host" header parse-host ] tri
75 [ >>host ] [ >>port ] bi*
78 : extract-cookies ( request -- request )
79 dup "cookie" header [ parse-cookie >>cookies ] when* ;
81 : read-request ( -- request )