(* Mosmlcgi.sml (c) Jonas Barklund, Computing Science Dept., Uppsala University, 1996. Support for form-based file upload via multipart/form-data, by Peter Sestoft (sestoft@dina.kvl.dk) December 1996. Anyone is granted the right to copy and/or use this code, provided that this note is retained, also in modified versions. The code is provided as is with no guarantee about any functionality. I take no responsibility for its proper function. *) val cgi_server_software = Process.getEnv("SERVER_SOFTWARE");val cgi_server_name = Process.getEnv("SERVER_NAME");val cgi_gateway_interface = Process.getEnv("GATEWAY_INTERFACE");val cgi_server_protocol = Process.getEnv("SERVER_PROTOCOL");val cgi_server_port = Process.getEnv("SERVER_PORT");val cgi_request_method = Process.getEnv("REQUEST_METHOD");val cgi_http_accept = Process.getEnv("HTTP_ACCEPT");val cgi_http_user_agent = Process.getEnv("HTTP_USER_AGENT");val cgi_http_referer = Process.getEnv("HTTP_REFERER");val cgi_path_info = Process.getEnv("PATH_INFO");val cgi_path_translated = Process.getEnv("PATH_TRANSLATED");val cgi_script_name = Process.getEnv("SCRIPT_NAME");val cgi_query_string = Process.getEnv("QUERY_STRING");val cgi_remote_host = Process.getEnv("REMOTE_HOST");val cgi_remote_addr = Process.getEnv("REMOTE_ADDR");val cgi_remote_user = Process.getEnv("REMOTE_USER");val cgi_remote_ident = Process.getEnv("REMOTE_IDENT");val cgi_auth_type = Process.getEnv("AUTH_TYPE");val cgi_content_type = Process.getEnv("CONTENT_TYPE");val cgi_content_length = Process.getEnv("CONTENT_LENGTH");val cgi_annotation_server = Process.getEnv("ANNOTATION_SERVER"); (* Added by Hans Molin, Uppsala, 1999 *)val cgi_http_cookie = Process.getEnv("HTTP_COOKIE");val cgi_http_forwarded = Process.getEnv("HTTP_FORWARDED");val cgi_http_host = Process.getEnv("HTTP_HOST");val cgi_http_proxy_connection = Process.getEnv("HTTP_PROXY_CONNECTION"); val cgi_script_filename = Process.getEnv("SCRIPT_FILENAME"); val cgi_document_root = Process.getEnv("DOCUMENT_ROOT");val cgi_server_admin = Process.getEnv("SERVER_ADMIN"); val cgi_api_version = Process.getEnv("API_VERSION");val cgi_the_request = Process.getEnv("THE_REQUEST");val cgi_request_uri = Process.getEnv("REQUEST_URI");val cgi_request_filename = Process.getEnv("REQUEST_FILENAME");val cgi_is_subreq = Process.getEnv("IS_SUBREQ"); local open Option TextIO fun intOf NONE = NONE | intOf (SOME s) = Int.fromString s val query_string = case cgi_request_method of SOME ("GET") => getOpt(cgi_query_string,"") | SOME ("POST") => inputN(stdIn, getOpt(intOf cgi_content_length, 0)) | _ => getOpt(cgi_query_string,""); (* Perhaps GET *) fun isn't c1 c2 = c1 <> c2 fun is c1 c2 = c1 = c2 (* For debugging, one may log to the httpd error_log: *) fun err s = TextIO.output(TextIO.stdErr, s); (* val _ = err query_string; val _ = err (Int.toString (getOpt(intOf cgi_content_length, 0))); *) (* Get the line starting with string s *) fun line s sus = let open Substring val (_, fullline) = position s sus val after = triml (String.size s) fullline in takel (fn c => c <> #"\r" andalso c <> #"\n") after end (* Get the value of boundary *) fun getboundary line = let open Substring val (_, bndeqn) = position "boundary=" line in if isEmpty bndeqn then NONE else SOME (string (triml 1 (dropl (isn't #"=") bndeqn))) end handle Option => NONE (* If CGI request type is multipart/form-data, then SOME(boundary): *) val multipart_boundary = let open Substring val content_type = all (valOf cgi_content_type) in if isPrefix "multipart/form-data;" content_type then getboundary content_type else NONE end handle Option => NONE val the_fields = case multipart_boundary of NONE => Substring.tokens (is #"&") (Substring.all query_string) | _ => [] val dict_with_codes = List.map (Substring.fields (is #"=")) the_fields; (* Decode CGI parameters: *) fun decode(sus) = let val sz = Substring.size(sus); exception Dehex; fun dehex(ch) = if #"0" <= ch andalso ch <= #"9" then Char.ord(ch) - Char.ord(#"0") else if #"A" <= ch andalso ch <= #"F" then (Char.ord(ch) - Char.ord(#"A")) + 10 else if #"a" <= ch andalso ch <= #"f" then (Char.ord(ch) - Char.ord(#"a")) + 10 else raise Dehex; fun decode_one(i) = Char.chr(16*dehex(Substring.sub(sus,i+1))+ dehex(Substring.sub(sus,i+2))); fun dec(i) = if i>=sz then [] else case Substring.sub(sus,i) of #"+" => #" "::dec(i+1) | #"%" => decode_one(i)::dec(i+3) | ch => ch::dec(i+1); in String.implode(dec(0)) end handle exn => (err ("decode failed on " ^ Substring.string sus ^ "\n"); "") fun addItem ((key, value), dict) = Splaymap.insert(dict, key, case Splaymap.peek(dict, key) of SOME vs => value :: vs | NONE => [value]) fun addField ([keysrc, valsrc], dict) = addItem ((decode keysrc, decode valsrc), dict) | addField (_, dict) = dict val cgi_dict = List.foldr addField (Splaymap.mkDict String.compare) dict_with_codes; fun keys dict = Splaymap.foldr (fn (key, _, res) => key :: res) [] dict (* Decode multipart messages: *) fun part_fields dict name = case Splaymap.peek (dict, name) of NONE => [] | SOME vals => vals fun part_field dict name = case Splaymap.peek (dict, name) of SOME (v :: _) => SOME v | _ => NONE fun getint NONE default = default | getint (SOME str) default = case Int.scan StringCvt.DEC Substring.getc (Substring.all str) of NONE => default | SOME(i, rest) => if Substring.isEmpty rest then i else default val multiparts = let open Substring val boundary = "--" ^ valOf multipart_boundary val skipbnd = dropl (isn't #"\n") val (_, contents) = position boundary (all query_string) fun loop rest = let val (pref, suff) = position boundary rest in if isEmpty pref orelse isEmpty suff then [] else pref :: loop (skipbnd suff) end in loop (skipbnd contents) end handle Option => [] fun decodepart (part : Substring.substring) = let open Char Substring val crlf2 = "\r\n\r\n" val (header, rest) = position crlf2 part val eqnsrc = line "Content-Disposition: form-data;" header val typ = line "Content-Type: " header val equations = List.map (fn f => dropl isSpace (dropr isSpace f)) (fields (is #";") eqnsrc) fun addField (eqn, dict) = let val (name, v) = splitl (isn't #"=") eqn (* Drop equals sign and quotes from value *) val value = triml 2 (trimr 1 v) in addItem((string name, string value), dict) end val dict = List.foldr addField (Splaymap.mkDict String.compare) equations val partname = case part_field dict "name" of NONE => "[Anonymous]" (* Is this is good idea? *) | SOME n => n in (partname, { fieldnames = keys dict, tyOpt = if isEmpty typ then NONE else SOME (string typ), dict = dict, (* Strip off CRLFCRLF and CRLF *) data = string (trimr 2 (triml 4 rest)) }) end type part = {fieldnames : string list, tyOpt : string option, dict : (string, string list) Splaymap.dict, data : string} val part_dict : (string, part list) Splaymap.dict = List.foldr addItem (Splaymap.mkDict String.compare) (List.map decodepart multiparts)in type part = part val cgi_partnames = keys part_dict fun cgi_part name = part_field part_dict name fun cgi_parts name = part_fields part_dict name fun part_fieldnames (p : part) = #fieldnames p fun part_type (p : part) = #tyOpt p fun part_data (p : part) = #data p fun part_field_strings (p : part) name = part_fields (#dict p) name fun part_field_string (p : part) name = part_field (#dict p) name fun part_field_integer (p : part) (name, default) = getint (part_field (#dict p) name) default val cgi_fieldnames = keys cgi_dict fun cgi_field_strings name = part_fields cgi_dict name fun cgi_field_string name = part_field cgi_dict name fun cgi_field_integer (name, default) = getint (cgi_field_string name) defaultend;
(*
Mosmlcgi.sml
(c) Jonas Barklund, Computing Science Dept., Uppsala University, 1996.
Support for form-based file upload via multipart/form-data,
by Peter Sestoft (sestoft@dina.kvl.dk) December 1996.
Anyone is granted the right to copy and/or use this code, provided
that this note is retained, also in modified versions. The code is
provided as is with no guarantee about any functionality. I take no
responsibility for its proper function.
*)
val cgi_server_software = Process.getEnv("SERVER_SOFTWARE");
val cgi_server_name = Process.getEnv("SERVER_NAME");
val cgi_gateway_interface = Process.getEnv("GATEWAY_INTERFACE");
val cgi_server_protocol = Process.getEnv("SERVER_PROTOCOL");
val cgi_server_port = Process.getEnv("SERVER_PORT");
val cgi_request_method = Process.getEnv("REQUEST_METHOD");
val cgi_http_accept = Process.getEnv("HTTP_ACCEPT");
val cgi_http_user_agent = Process.getEnv("HTTP_USER_AGENT");
val cgi_http_referer = Process.getEnv("HTTP_REFERER");
val cgi_path_info = Process.getEnv("PATH_INFO");
val cgi_path_translated = Process.getEnv("PATH_TRANSLATED");
val cgi_script_name = Process.getEnv("SCRIPT_NAME");
val cgi_query_string = Process.getEnv("QUERY_STRING");
val cgi_remote_host = Process.getEnv("REMOTE_HOST");
val cgi_remote_addr = Process.getEnv("REMOTE_ADDR");
val cgi_remote_user = Process.getEnv("REMOTE_USER");
val cgi_remote_ident = Process.getEnv("REMOTE_IDENT");
val cgi_auth_type = Process.getEnv("AUTH_TYPE");
val cgi_content_type = Process.getEnv("CONTENT_TYPE");
val cgi_content_length = Process.getEnv("CONTENT_LENGTH");
val cgi_annotation_server = Process.getEnv("ANNOTATION_SERVER");
(* Added by Hans Molin, Uppsala, 1999 *)
val cgi_http_cookie = Process.getEnv("HTTP_COOKIE");
val cgi_http_forwarded = Process.getEnv("HTTP_FORWARDED");
val cgi_http_host = Process.getEnv("HTTP_HOST");
val cgi_http_proxy_connection = Process.getEnv("HTTP_PROXY_CONNECTION");
val cgi_script_filename = Process.getEnv("SCRIPT_FILENAME");
val cgi_document_root = Process.getEnv("DOCUMENT_ROOT");
val cgi_server_admin = Process.getEnv("SERVER_ADMIN");
val cgi_api_version = Process.getEnv("API_VERSION");
val cgi_the_request = Process.getEnv("THE_REQUEST");
val cgi_request_uri = Process.getEnv("REQUEST_URI");
val cgi_request_filename = Process.getEnv("REQUEST_FILENAME");
val cgi_is_subreq = Process.getEnv("IS_SUBREQ");
local
open Option TextIO
fun intOf NONE = NONE
| intOf (SOME s) = Int.fromString s
val query_string =
case cgi_request_method of
SOME ("GET") => getOpt(cgi_query_string,"")
| SOME ("POST") => inputN(stdIn, getOpt(intOf cgi_content_length, 0))
| _ => getOpt(cgi_query_string,""); (* Perhaps GET *)
fun isn't c1 c2 = c1 <> c2
fun is c1 c2 = c1 = c2
(* For debugging, one may log to the httpd error_log: *)
fun err s = TextIO.output(TextIO.stdErr, s);
(* val _ = err query_string;
val _ = err (Int.toString (getOpt(intOf cgi_content_length, 0)));
*)
(* Get the line starting with string s *)
fun line s sus =
let open Substring
val (_, fullline) = position s sus
val after = triml (String.size s) fullline
in takel (fn c => c <> #"\r" andalso c <> #"\n") after end
(* Get the value of boundary *)
fun getboundary line =
let open Substring
val (_, bndeqn) = position "boundary=" line
in
if isEmpty bndeqn then NONE
else SOME (string (triml 1 (dropl (isn't #"=") bndeqn)))
end
handle Option => NONE
(* If CGI request type is multipart/form-data, then SOME(boundary): *)
val multipart_boundary =
let open Substring
val content_type = all (valOf cgi_content_type)
in
if isPrefix "multipart/form-data;" content_type then
getboundary content_type
else
NONE
end
handle Option => NONE
val the_fields =
case multipart_boundary of
NONE => Substring.tokens (is #"&") (Substring.all query_string)
| _ => []
val dict_with_codes = List.map (Substring.fields (is #"=")) the_fields;
(* Decode CGI parameters: *)
fun decode(sus) =
let
val sz = Substring.size(sus);
exception Dehex;
fun dehex(ch) =
if #"0" <= ch andalso ch <= #"9"
then Char.ord(ch) - Char.ord(#"0")
else if #"A" <= ch andalso ch <= #"F"
then (Char.ord(ch) - Char.ord(#"A")) + 10
else if #"a" <= ch andalso ch <= #"f"
then (Char.ord(ch) - Char.ord(#"a")) + 10
else raise Dehex;
fun decode_one(i) =
Char.chr(16*dehex(Substring.sub(sus,i+1))+
dehex(Substring.sub(sus,i+2)));
fun dec(i) =
if i>=sz then []
else case Substring.sub(sus,i)
of #"+" => #" "::dec(i+1)
| #"%" => decode_one(i)::dec(i+3)
| ch => ch::dec(i+1);
in
String.implode(dec(0))
end handle exn =>
(err ("decode failed on " ^ Substring.string sus ^ "\n"); "")
fun addItem ((key, value), dict) =
Splaymap.insert(dict, key, case Splaymap.peek(dict, key) of
SOME vs => value :: vs
| NONE => [value])
fun addField ([keysrc, valsrc], dict) =
addItem ((decode keysrc, decode valsrc), dict)
| addField (_, dict) = dict
val cgi_dict =
List.foldr addField (Splaymap.mkDict String.compare) dict_with_codes;
fun keys dict = Splaymap.foldr (fn (key, _, res) => key :: res) [] dict
(* Decode multipart messages: *)
fun part_fields dict name =
case Splaymap.peek (dict, name) of
NONE => []
| SOME vals => vals
fun part_field dict name =
case Splaymap.peek (dict, name) of
SOME (v :: _) => SOME v
| _ => NONE
fun getint NONE default = default
| getint (SOME str) default =
case Int.scan StringCvt.DEC Substring.getc (Substring.all str) of
NONE => default
| SOME(i, rest) => if Substring.isEmpty rest then i else default
val multiparts =
let open Substring
val boundary = "--" ^ valOf multipart_boundary
val skipbnd = dropl (isn't #"\n")
val (_, contents) = position boundary (all query_string)
fun loop rest =
let val (pref, suff) = position boundary rest
in
if isEmpty pref orelse isEmpty suff then []
else pref :: loop (skipbnd suff)
end
in loop (skipbnd contents) end
handle Option => []
fun decodepart (part : Substring.substring) =
let open Char Substring
val crlf2 = "\r\n\r\n"
val (header, rest) = position crlf2 part
val eqnsrc = line "Content-Disposition: form-data;" header
val typ = line "Content-Type: " header
val equations = List.map (fn f => dropl isSpace (dropr isSpace f))
(fields (is #";") eqnsrc)
fun addField (eqn, dict) =
let val (name, v) = splitl (isn't #"=") eqn
(* Drop equals sign and quotes from value *)
val value = triml 2 (trimr 1 v)
in addItem((string name, string value), dict) end
val dict =
List.foldr addField (Splaymap.mkDict String.compare) equations
val partname =
case part_field dict "name" of
NONE => "[Anonymous]" (* Is this is good idea? *)
| SOME n => n
in
(partname,
{ fieldnames = keys dict,
tyOpt = if isEmpty typ then NONE else SOME (string typ),
dict = dict,
(* Strip off CRLFCRLF and CRLF *)
data = string (trimr 2 (triml 4 rest))
})
end
type part = {fieldnames : string list,
tyOpt : string option,
dict : (string, string list) Splaymap.dict,
data : string}
val part_dict : (string, part list) Splaymap.dict =
List.foldr addItem (Splaymap.mkDict String.compare)
(List.map decodepart multiparts)
in
type part = part
val cgi_partnames = keys part_dict
fun cgi_part name = part_field part_dict name
fun cgi_parts name = part_fields part_dict name
fun part_fieldnames (p : part) = #fieldnames p
fun part_type (p : part) = #tyOpt p
fun part_data (p : part) = #data p
fun part_field_strings (p : part) name = part_fields (#dict p) name
fun part_field_string (p : part) name = part_field (#dict p) name
fun part_field_integer (p : part) (name, default) =
getint (part_field (#dict p) name) default
val cgi_fieldnames = keys cgi_dict
fun cgi_field_strings name = part_fields cgi_dict name
fun cgi_field_string name = part_field cgi_dict name
fun cgi_field_integer (name, default) =
getint (cgi_field_string name) default
end;