1 (* Title: parse_scgi_req.ML
2 Author: Timothy Bourke, NICTA
4 Parses an SCGI (Simple Common Gateway Interface) header.
5 See: http://python.ca/scgi/protocol.txt
10 exception InvalidReq of string
12 datatype req_method = Get | Head | Post
16 path_translated : string,
18 request_method : req_method,
19 query_string : string Symtab.table,
20 content_type : Mime.t option,
21 environment : Word8VectorSlice.slice Symtab.table
24 val parse : BinIO.instream -> t * (BinIO.instream * int)
25 val test : string -> unit
27 val show : t -> string
30 structure ScgiReq : SCGI_REQ =
33 exception InvalidReq of string;
35 datatype req_method = Get | Head | Post;
39 path_translated : string,
41 request_method : req_method,
42 query_string : string Symtab.table,
43 content_type : Mime.t option,
44 environment : Word8VectorSlice.slice Symtab.table
47 fun parse_req_method "POST" = Post
48 | parse_req_method "HEAD" = Head
49 | parse_req_method _ = Get;
51 fun show_req_method Get = "Get"
52 | show_req_method Post = "Post"
53 | show_req_method Head = "Head";
55 fun find_nulls (idx, 0wx00, idxs) = idx::idxs
56 | find_nulls (_, _, idxs) = idxs;
58 fun read_net_string fin =
60 fun read_size (_, NONE) = raise InvalidReq "Bad netstring length."
61 | read_size (t, SOME 0wx3a) = t
62 | read_size (t, SOME d) =
64 val n = (Word8.toInt d) - 0x30;
66 if n >=0 andalso n <= 9
67 then read_size (t * 10 + n, BinIO.input1 fin)
68 else read_size (t, NONE)
70 val size = read_size (0, BinIO.input1 fin);
71 val payload = BinIO.inputN (fin, size);
73 (case (Word8Vector.length payload = size, BinIO.input1 fin) of
74 (true, SOME 0wx2c) => payload
75 | _ => raise InvalidReq "Bad netstring.")
78 fun split_fields vec =
80 val nulls = ~1 :: (Word8Vector.foldri find_nulls [] vec);
83 | pr (SOME i) = "SOME " ^ Int.toString i;
85 fun hd_diff (i1::i2::_) = SOME (i2 - i1 - 1)
89 | slice (idxs as idx::idxs') =
90 Word8VectorSlice.slice (vec, idx + 1, hd_diff idxs) :: slice idxs';
92 fun make_pairs (x::y::xys) = (Byte.unpackStringVec x, y) :: make_pairs xys
95 in make_pairs (slice nulls) end;
99 val raw_fields = read_net_string fin;
100 val fields = split_fields raw_fields;
101 val env = Symtab.make fields;
104 (case Symtab.lookup env name of
106 | SOME wv => Byte.unpackStringVec wv);
109 (the o Int.fromString o field) "CONTENT_LENGTH"
110 handle _ => raise InvalidReq "Bad CONTENT_LENGTH";
113 path_info = field "PATH_INFO",
114 path_translated = field "PATH_TRANSLATED",
115 script_name = field "SCRIPT_NAME",
116 request_method = (parse_req_method o field) "REQUEST_METHOD",
117 query_string = (HttpUtil.parse_query_string o field) "QUERY_STRING",
118 content_type = (Mime.parse_type o field) "CONTENT_TYPE",
122 in (req, (fin, content_length)) end;
124 fun show (Req {path_info, path_translated, script_name,
125 request_method, query_string, content_type, environment}) =
127 fun show_symtab to_string table = let
128 fun show (n, v) r = ["\t", n, " = \"", to_string v, "\"\n"] @ r;
129 in Symtab.fold show table [] end;
132 (["path_info: \"", path_info, "\"\n",
133 "path_translated: \"", path_translated, "\"\n",
134 "script_name: \"", script_name, "\"\n",
135 "request_method: \"", show_req_method request_method, "\"\n",
138 show_symtab I query_string
141 (the_default "" o Option.map Mime.show_type) content_type, "\n",
144 show_symtab Byte.unpackStringVec environment)
149 val fin = BinIO.openIn path;
150 val (req, cs) = parse fin;
151 val () = TextIO.print (show req);
154 |> Word8VectorSlice.full
155 |> Byte.unpackStringVec
157 in BinIO.closeIn fin end;