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 list StringMap
.map
)
82 fun setHeader (n
, v
) = headers
:= StringMap
.insert (!headers
, n
, v
)
83 fun getHeader n
= StringMap
.find (!headers
, n
)
84 fun addHeader (n
, v
) =
85 headers
:= StringMap
.insert (!headers
, n
, case getHeader n
of
87 | SOME vs
=> vs @
[v
])
88 fun getSingleHeader n
=
89 (case StringMap
.find (!headers
, n
) of
93 val text
= ref ([] : string list
)
95 fun print x
= text
:= x
:: (!text
)
96 fun clear () = text
:= []
97 fun noOutput () = !text
= []
99 (TextIO.print
"Status: 200\n";
100 StringMap
.appi (fn (n
, vs
) =>
101 app (fn v
=> (TextIO.print n
;
107 TextIO.print (String.concat (List.rev (!text
))))
109 val getCgi
= OS
.Process
.getEnv
111 val explode
= CharVector
.foldr (op::) []
115 fun xch #
"<" = "<"
118 | xch #
"\"" = """
121 String.concat (map
xch (explode s
))
126 fun xch #
"<" = "<"
129 | xch #
"\"" = """
130 | xch #
"\n" = "<br />"
133 String.concat (map
xch (explode s
))
145 if Char.isAlphaNum ch
orelse ch
= #
"." then
147 else if ch
= #
" " then
150 "%" ^
pad (2, "0") (Int.fmt
StringCvt.HEX (ord ch
))
152 String.concat (map
xch (explode s
))
155 exception Format
of string
157 fun stoiOpt s
= Int.fromString s
159 (case Int.fromString s
of
160 NONE
=> raise Format s
163 fun storOpt s
= Real.fromString s
165 (case Real.fromString s
of
166 NONE
=> raise Format s
170 StringMap
.foldli (fn (n
, vs
, s
) => foldl (fn (v
, s
) => s ^
" VALUE: " ^ v
) (s ^
" NAME: " ^ n
) vs
)
173 val exn
= ref (NONE
: exn option
)
174 fun setExn ex
= exn
:= SOME ex
175 fun getExn () = valOf (!exn
)
177 type cookie
= {name
: string, value
: string, expires
: Date
.date option
,
178 domain
: string option
, path
: string option
, secure
: bool}
180 fun setCookie
{name
, value
, expires
, domain
, path
, secure
} =
182 val s
= name ^
"=" ^ value
186 | SOME date
=> s ^
"; expires=" ^ Date
.fmt
"%a, %d-%b-%Y %H:%M:%S GMT" date
190 | SOME dom
=> s ^
"; domain=" ^ dom
194 | SOME path
=> s ^
"; path=" ^ path
201 addHeader ("Set-Cookie", s
)
205 (case getCgi
"HTTP_COOKIE" of
209 fun search (n
'::v
::rest
) =
216 search (String.tokens (fn ch
=> ch
= #
"=" orelse ch
= #
";" orelse ch
= #
" ") cookies
)
220 case getCgi
"REMOTE_HOST" of
221 NONE
=> getCgi
"REMOTE_ADDR"
224 fun plusSeconds (t
, s
) = Time
.+ (t
, Time
.fromSeconds (LargeInt
.fromInt s
))
225 fun minusSeconds (t
, s
) = Time
.- (t
, Time
.fromSeconds (LargeInt
.fromInt s
))
234 else if String.sub (s
, i
) = ch
then
235 SOME (String.substring (s
, 0, i
), String.extract (s
, i
+1, NONE
))
242 fun replaceUrlVar (url
, n
, v
) =
243 case split (url
, #
"?") of
247 fun doPair (nv
, (L
, yn
)) =
248 (case split (nv
, #
"=") of
252 ((n ^
"=" ^ v
)::L
, true)
255 val (pairs
, yn
) = foldr
doPair ([], false) (String.tokens (fn ch
=> ch
= #
"&") qs
)
260 (n ^
"=" ^ v
) :: pairs
265 String.concat (uri
:: "?" :: nv
:: foldr (fn (nv
, L
) => "&"::nv
::L
) [] rest
)