structure Web :> WEB =
struct
- val params : string StringMap.map ref = ref StringMap.empty
+ fun for f (r1, r2) =
+ if r1 < r2 then
+ let
+ fun loop i =
+ if i > r2 then
+ ()
+ else
+ (f i;
+ loop (i+1))
+ in
+ loop r1
+ end
+ else
+ let
+ fun loop i =
+ if i < r2 then
+ ()
+ else
+ (f i;
+ loop (i-1))
+ in
+ loop r1
+ end
- val paramStack : string StringMap.map list ref = ref []
+ val params : string list StringMap.map ref = ref StringMap.empty
+
+ val paramStack : string list StringMap.map list ref = ref []
fun setParam (n, v) = params := StringMap.insert (!params, n, v)
+ fun setSingleParam (n, v) = setParam (n, [v])
fun getParam v =
(case StringMap.find (!params, v) of
NONE => ""
- | SOME s => s)
+ | SOME [] => ""
+ | SOME (s::_) => s)
+
+ fun getMultiParam v =
+ (case StringMap.find (!params, v) of
+ NONE => []
+ | SOME l => l)
fun pushParams nvs =
(paramStack := (!params) :: (!paramStack);
((f ()) handle ex => (popParams (); raise ex))
before popParams ())
+ val headers = ref (StringMap.empty : string list StringMap.map)
+ fun setHeader (n, v) = headers := StringMap.insert (!headers, n, v)
+ fun getHeader n = StringMap.find (!headers, n)
+ fun addHeader (n, v) =
+ headers := StringMap.insert (!headers, n, case getHeader n of
+ NONE => [v]
+ | SOME vs => vs @ [v])
+ fun getSingleHeader n =
+ (case StringMap.find (!headers, n) of
+ SOME (v::_) => SOME v
+ | _ => NONE)
+
val text = ref ([] : string list)
fun print x = text := x :: (!text)
-
+ fun clear () = text := []
+ fun noOutput () = !text = []
fun output () =
- (TextIO.print "Status: 200\nContent-type: text/html\n\n";
+ (TextIO.print "Status: 200\n";
+ StringMap.appi (fn (n, vs) =>
+ app (fn v => (TextIO.print n;
+ TextIO.print ": ";
+ TextIO.print v;
+ TextIO.print "\n"))
+ vs) (!headers);
+ TextIO.print "\n";
TextIO.print (String.concat (List.rev (!text))))
+
+ val getCgi = OS.Process.getEnv
+
+ val explode = CharVector.foldr (op::) []
+
+ fun html s =
+ let
+ fun xch #"<" = "<"
+ | xch #">" = ">"
+ | xch #"&" = "&"
+ | xch #"\"" = """
+ | xch ch = str ch
+ in
+ String.concat (map xch (explode s))
+ end
+
+ fun htmlNl s =
+ let
+ fun xch #"<" = "<"
+ | xch #">" = ">"
+ | xch #"&" = "&"
+ | xch #"\"" = """
+ | xch #"\n" = "<br />"
+ | xch ch = str ch
+ in
+ String.concat (map xch (explode s))
+ end
+
+ fun pad (n, ch) s =
+ if size s < n then
+ pad (n, ch) (ch ^ s)
+ else
+ s
+
+ fun urlEncode s =
+ let
+ fun xch ch =
+ if Char.isAlphaNum ch orelse ch = #"." then
+ str ch
+ else if ch = #" " then
+ "+"
+ else
+ "%" ^ pad (2, "0") (Int.fmt StringCvt.HEX (ord ch))
+ in
+ String.concat (map xch (explode s))
+ end
+
+ exception Format of string
+
+ fun stoiOpt s = Int.fromString s
+ fun stoi s =
+ (case Int.fromString s of
+ NONE => raise Format s
+ | SOME i => i)
+
+ fun storOpt s = Real.fromString s
+ fun stor s =
+ (case Real.fromString s of
+ NONE => raise Format s
+ | SOME r => r)
+
+ fun summary () =
+ StringMap.foldli (fn (n, vs, s) => foldl (fn (v, s) => s ^ " VALUE: " ^ v) (s ^ " NAME: " ^ n) vs)
+ "" (!params)
+
+ val exn = ref (NONE : exn option)
+ fun setExn ex = exn := SOME ex
+ fun getExn () = valOf (!exn)
+
+ type cookie = {name : string, value : string, expires : Date.date option,
+ domain : string option, path : string option, secure : bool}
+
+ fun setCookie {name, value, expires, domain, path, secure} =
+ let
+ val s = name ^ "=" ^ value
+ val s =
+ case expires of
+ NONE => s
+ | SOME date => s ^ "; expires=" ^ Date.fmt "%a, %d-%b-%Y %H:%M:%S GMT" date
+ val s =
+ case domain of
+ NONE => s
+ | SOME dom => s ^ "; domain=" ^ dom
+ val s =
+ case path of
+ NONE => s
+ | SOME path => s ^ "; path=" ^ path
+ val s =
+ if secure then
+ s ^ "; secure"
+ else
+ s
+ in
+ addHeader ("Set-Cookie", s)
+ end
+
+ fun getCookie n =
+ (case getCgi "HTTP_COOKIE" of
+ NONE => NONE
+ | SOME cookies =>
+ let
+ fun search (n'::v::rest) =
+ if n = n' then
+ SOME v
+ else
+ search rest
+ | search _ = NONE
+ in
+ search (String.tokens (fn ch => ch = #"=" orelse ch = #";" orelse ch = #" ") cookies)
+ end)
+
+ fun remoteHost () =
+ case getCgi "REMOTE_HOST" of
+ NONE => getCgi "REMOTE_ADDR"
+ | h => h
+
+ fun plusSeconds (t, s) = Time.+ (t, Time.fromSeconds (LargeInt.fromInt s))
+ fun minusSeconds (t, s) = Time.- (t, Time.fromSeconds (LargeInt.fromInt s))
+
+ fun split (s, ch) =
+ let
+ val len = size s
+
+ fun find i =
+ if i >= len then
+ NONE
+ else if String.sub (s, i) = ch then
+ SOME (String.substring (s, 0, i), String.extract (s, i+1, NONE))
+ else
+ find (i+1)
+ in
+ find 0
+ end
+
+ fun replaceUrlVar (url, n, v) =
+ case split (url, #"?") of
+ NONE => url
+ | SOME (uri, qs) =>
+ let
+ fun doPair (nv, (L, yn)) =
+ (case split (nv, #"=") of
+ NONE => (nv::L, yn)
+ | SOME (n', v') =>
+ if n = n' then
+ ((n ^ "=" ^ v)::L, true)
+ else
+ (nv::L, yn))
+ val (pairs, yn) = foldr doPair ([], false) (String.tokens (fn ch => ch = #"&") qs)
+ val pairs =
+ if yn then
+ pairs
+ else
+ (n ^ "=" ^ v) :: pairs
+ in
+ case pairs of
+ [] => url
+ | nv::rest =>
+ String.concat (uri :: "?" :: nv :: foldr (fn (nv, L) => "&"::nv::L) [] rest)
+ end
end
\ No newline at end of file
HCoop / bpt / mlt.git / blobdiff