2 * Dynamic web page generation
with Standard ML
3 * Copyright (C
) 2003 Adam Chlipala
5 * This library is free software
; you can redistribute it
and/or
6 * modify it under the terms
of the GNU Lesser General Public
7 * License
as published by the Free Software Foundation
; either
8 * version
2.1 of the License
, or (at your option
) any later version
.
10 * This library is distributed
in the hope that it will be useful
,
11 * but WITHOUT ANY WARRANTY
; without even the implied warranty
of
12 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
. See the GNU
13 * Lesser General Public License for more details
.
15 * You should have received a copy
of the GNU Lesser General Public
16 * License along
with this library
; if not
, write to the Free Software
17 * Foundation
, Inc
., 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
22 structure Web
:> WEB
=
48 val params
: string list StringMap
.map ref
= ref StringMap
.empty
50 val paramStack
: string list StringMap
.map list ref
= ref
[]
52 fun setParam (n
, v
) = params
:= StringMap
.insert (!params
, n
, v
)
53 fun setSingleParam (n
, v
) = setParam (n
, [v
])
56 (case StringMap
.find (!params
, v
) of
62 (case StringMap
.find (!params
, v
) of
67 (paramStack
:= (!params
) :: (!paramStack
);
72 [] => raise Fail
"Empty params stack in popParams"
73 | h
::t
=> (params
:= h
;
76 fun withParams f nvs
=
78 ((f ()) handle ex
=> (popParams (); raise ex
))
81 val headers
= ref (StringMap
.empty
: string StringMap
.map
)
82 fun setHeader (n
, v
) = headers
:= StringMap
.insert (!headers
, n
, v
)
83 fun getHeader n
= StringMap
.find (!headers
, n
)
85 val text
= ref ([] : string list
)
87 fun print x
= text
:= x
:: (!text
)
88 fun clear () = text
:= []
89 fun noOutput () = !text
= []
91 (TextIO.print
"Status: 200\n";
92 StringMap
.appi (fn (n
, v
) => (TextIO.print n
;
95 TextIO.print
"\n")) (!headers
);
97 TextIO.print (String.concat (List.rev (!text
))))
99 val getCgi
= OS
.Process
.getEnv
101 val explode
= CharVector
.foldr (op::) []
105 fun xch #
"<" = "<"
108 | xch #
"\"" = """
111 String.concat (map
xch (explode s
))
116 fun xch #
"<" = "<"
119 | xch #
"\"" = """
120 | xch #
"\n" = "<br />"
123 String.concat (map
xch (explode s
))
135 if Char.isAlphaNum ch
orelse ch
= #
"." then
137 else if ch
= #
" " then
140 "%" ^
pad (2, "0") (Int.fmt
StringCvt.HEX (ord ch
))
142 String.concat (map
xch (explode s
))
145 exception Format
of string
147 fun stoiOpt s
= Int.fromString s
149 (case Int.fromString s
of
150 NONE
=> raise Format s
153 fun storOpt s
= Real.fromString s
155 (case Real.fromString s
of
156 NONE
=> raise Format s
160 StringMap
.foldli (fn (n
, vs
, s
) => foldl (fn (v
, s
) => s ^
" VALUE: " ^ v
) (s ^
" NAME: " ^ n
) vs
)
163 val exn
= ref (NONE
: exn option
)
164 fun setExn ex
= exn
:= SOME ex
165 fun getExn () = valOf (!exn
)
167 type cookie
= {name
: string, value
: string, expires
: Date
.date option
,
168 domain
: string option
, path
: string option
, secure
: bool}
170 fun setCookie
{name
, value
, expires
, domain
, path
, secure
} =
172 val s
= name ^
"=" ^ value
176 | SOME date
=> s ^
"; expires=" ^ Date
.fmt
"%a, %d-%b-%Y %H:%M:%S GMT" date
180 | SOME dom
=> s ^
"; domain=" ^ dom
184 | SOME path
=> s ^
"; path=" ^ path
191 setHeader ("Set-Cookie", s
)
195 (case getCgi
"HTTP_COOKIE" of
199 fun search (n
'::v
::rest
) =
206 search (String.tokens (fn ch
=> ch
= #
"=" orelse ch
= #
";" orelse ch
= #
" ") cookies
)
210 case getCgi
"REMOTE_HOST" of
211 NONE
=> getCgi
"REMOTE_ADDR"
214 fun minusSeconds (t
, s
) = Time
.- (t
, Time
.fromSeconds (LargeInt
.fromInt s
))
223 else if String.sub (s
, i
) = ch
then
224 SOME (String.substring (s
, 0, i
), String.extract (s
, i
+1, NONE
))
231 fun replaceUrlVar (url
, n
, v
) =
232 case split (url
, #
"?") of
236 fun doPair (nv
, (L
, yn
)) =
237 (case split (nv
, #
"=") of
241 ((n ^
"=" ^ v
)::L
, true)
244 val (pairs
, yn
) = foldr
doPair ([], false) (String.tokens (fn ch
=> ch
= #
"&") qs
)
249 (n ^
"=" ^ v
) :: pairs
254 String.concat (uri
:: "?" :: nv
:: foldr (fn (nv
, L
) => "&"::nv
::L
) [] rest
)