Anubis / Xlib | GitLab

Commit e88c944b25a154d938edc31c91f017fa5c9660b7

Authored by Totoro 2013-06-15 20:45:16 +0200

update the calexium lib to be compatible with anubis compiler 1.12.2.0. especial…

…ly replace alert by should_not_happen and "connect to file" by file
Remove obsolete file CXM_html.anubis

Showing 3 changed files with 4731 additions and 7127 deletions Show diff stats

Inline Side-by-side

web/CXM_cookies.anubis

Wrap text Show/Hide comments View file @e88c944

1		-
2		- Project The Anubis Project
3		-
4		- Title Managing Cookies.
5		-
6		- Copyright Copyright (c) Alain Prouté 2001.
7		-
8		-
9		- Author Alain Prouté
10		-
11		-
12		-
13		-
14		-read tools/basis.anubis
15		-read system/string.anubis
16		-read CXM_common.anubis
17		-read CXM_html.anubis
18		-read CXM_http_get_common.anubis
19		-
20		-
21		- Overview
22		- Cookies are defined in RFC 2109. Here is the corresponding Anubis type:
23		-
24		- Each cookie has an server name (the name of the server who constructed the cookie), a
25		- name, a value, and several attributes.
26		-
27		-public type Cookie:
28		- cookie(String server_name, // of the server who sent the cookie
29		- String name, // of the cookie
30		- String value, // of the cookie
31		- // attributes:
32		- Maybe(String) comment, // cookies may have human readable comments
33		- Maybe(String) domain, // domain name as sent by the server
34		- Int validity, // cookie still valid if this is > now
35		- Maybe(String) path, // server path for which the cookie is valid
36		- Bool secure, // if true, do not send this cookie over an insecure link
37		- Int version). // Cookie version (normally 1: rfc 2109)
38		-
39		-
40		- Cookies are sent by servers through 'Set-Cookie' HTTP headers. The function
41		- 'get_cookies' retrieves a list of cookies from a list of HTTP headers.
42		-
43		-public define List(Cookie)
44		- get_cookies
45		- (
46		- String server_name, // name of server who sent the cookies
47		- List(HTTP_header) headers // HTTP headers sent by this server
48		- ).
49		-
50		-public define Maybe(Cookie)
51		- find_cookie
52		- (
53		- String name,
54		- List(Cookie) cookies
55		- ).
56		-
57		-
58		-
59		-
60		-
61		- Normally, this function is used on the list of HTTP headers returned by either
62		- 'http_get' of 'https_get'.
63		-
64		-
65		- Before they can be sent back to their origin server, cookies must be reformated, in
66		- order to produce 'Cookie' HTTP headers:
67		-
68		-public define List(HTTP_header)
69		- reformat_cookies
70		- (
71		- String server_name,
72		- String uri,
73		- List(Cookie) cookies
74		- ).
75		-
76		- The result of 'reformat_cookies' may be appended to the list of headers given as
77		- argument to 'http_get' or to 'https_get'.
78		-
79		- In the meantime, you may examine and maybe discard cookies, you may 'save' them into a
80		- file, and 'retrieve' them later.
81		-
82		-
83		-
84		-
85		- ------- That all for the public part. -------------------------------------------------
86		-
87		-
88		- Here is the syntax of a 'Set-Cookie' header (according to RFC 2109):
89		-
90		- set-cookie = "Set-Cookie:" cookies
91		- cookies = 1#cookie
92		- cookie = NAME "=" VALUE *(";" cookie-av)
93		- NAME = token
94		- VALUE = value
95		- value = token \| quoted-string
96		- cookie-av = "Comment" "=" value
97		- \| "Domain" "=" value
98		- \| "Max-Age" "=" value
99		- \| "Path" "=" value
100		- \| "Secure"
101		- \| "Version" "=" 1*DIGIT
102		-
103		-
104		- According to RFC 2616 (obsolating RFC 2068) defining HTTP 1.1, 'control characters' are
105		- 0 to 31 and DEL (127). A 'separator' is one of:
106		-
107		- ( ) < > @ , ; : \ " / [ ] ? = { } 32(space) and 9(tab) "
108		-
109		- Now, a token is a non empty sequence of ASCII characters (0 to 127), but not including
110		- any control character or any separator. As a consequence, characters admissible in a
111		- 'RFC 2616 token' are:
112		-
113		- 33 !
114		- 35 to 39 # $ & '
115		- 42 43 * +
116		- 45 46 - .
117		- 48 to 57 0 ... 9
118		- 65 to 90 A ... Z
119		- 94 to 122 ^ _ ` a ... z
120		- 124 126 \| ~
121		-
122		-define Bool
123		- is_token_char
124		- (
125		- Word8 c
126		- ) =
127		- if c +< 33 then false else
128		- if c +< 34 then true else
129		- if c +< 35 then false else
130		- if c +< 40 then true else
131		- if c +< 42 then false else
132		- if c +< 44 then true else
133		- if c +< 45 then false else
134		- if c +< 47 then true else
135		- if c +< 48 then false else
136		- if c +< 58 then true else
137		- if c +< 65 then false else
138		- if c +< 91 then true else
139		- if c +< 94 then false else
140		- if c +< 123 then true else
141		- if c +< 124 then false else
142		- if c = 124 then true else
143		- c = 126.
144		-
145		- value char are token added of =, (, )
146		-
147		-define Bool
148		- is_value_char
149		- (
150		- Word8 c
151		- ) =
152		- if c +< 33 then false else
153		- if c +< 34 then true else
154		- if c +< 35 then false else
155		- if c +< 44 then true else
156		- if c +< 45 then false else
157		- if c +< 47 then true else
158		- if c +< 48 then false else
159		- if c +< 58 then true else
160		- if c +< 61 then false else
161		- if c +< 62 then true else
162		- if c +< 65 then false else
163		- if c +< 91 then true else
164		- if c +< 94 then false else
165		- if c +< 123 then true else
166		- if c +< 124 then false else
167		- if c = 124 then true else
168		- c = 126.
169		-
170		- From the grammar, it is clear that atomic entities (called 'tokens' by YACC) are:
171		-
172		- - tokens (in the sens of RFC 2616) some of which have to be recognized as keywords
173		- - quoted strings
174		- - equal sign
175		- - colon
176		- - semi-colon
177		-
178		- Hence, the following type:
179		-
180		-public type Atom:
181		- end_of_input,
182		- error,
183		- comment,
184		- domain,
185		- max_age,
186		- path,
187		- secure,
188		- version,
189		- token(String),
190		- quoted_string(String),
191		- equals,
192		- colon,
193		- semi_colon.
194		-
195		-
196		-variable List(Atom) unput_atoms = [].
197		-
198		-define One
199		- unput_atom
200		- (
201		- Atom a
202		- ) =
203		- unput_atoms <- [a . *unput_atoms].
204		-
205		-define Atom
206		- recognize_keyword
207		- (
208		- String s
209		- ) =
210		- with l = to_lower(s),
211		- if l = "comment" then comment else
212		- if l = "domain" then domain else
213		- if l = "max-age" then max_age else
214		- if l = "path" then path else
215		- if l = "secure" then secure else
216		- if l = "version" then version else
217		- token(s).
218		-
219		-
220		-variable String input = "". From which cookies will be read.
221		-variable Int index = 0. Current position within 'input'.
222		-
223		-define Maybe(Word8)
224		- next_char
225		- =
226		- if nth(index,input) is
227		- {
228		- failure then failure,
229		- success(c) then
230		- index <- *index+1;
231		- success(c)
232		- }.
233		-
234		-define One
235		- unput_char
236		- =
237		- index <- *index-1.
238		-
239		-define Atom
240		- read_token
241		- (
242		- List(Word8) so_far, // contains at least 1 character
243		- (Word8) -> Bool is_valid_char
244		- ) =
245		- if next_char is
246		- {
247		- failure then recognize_keyword(implode(reverse(so_far))),
248		- success(c) then
249		- if is_valid_char(c)
250		- then read_token([c . so_far], is_valid_char)
251		- else unput_char; recognize_keyword(implode(reverse(so_far)))
252		- }.
253		-
254		-define Atom
255		- read_quoted_string
256		- (
257		- List(Word8) so_far
258		- ) =
259		- if next_char is
260		- {
261		- failure then quoted_string(implode(reverse(so_far))),
262		- success(c) then
263		- if c = '\"'
264		- then quoted_string(implode(reverse(so_far)))
265		- else read_quoted_string([c . so_far])
266		- }.
267		-
268		-define Bool
269		- is_blank
270		- (
271		- Word8 c
272		- ) =
273		- c +=< ' '.
274		-
275		- Reading an atom from the input:
276		-
277		-define Atom
278		- read_atom
279		- =
280		- if *unput_atoms is
281		- {
282		- [ ] then
283		- if next_char is
284		- {
285		- failure then end_of_input,
286		- success(c) then
287		- if is_blank(c) then read_atom else // skip blanks
288		- if is_token_char(c) then read_token([c], is_token_char) else
289		- if c = '\"' then read_quoted_string([]) else
290		- if c = '=' then equals else
291		- if c = ':' then colon else
292		- if c = ';' then semi_colon else
293		- error
294		- },
295		- [h . t] then
296		- unput_atoms <- t; h
297		- }.
298		-
299		-define Atom
300		- read_value
301		- =
302		- if *unput_atoms is
303		- {
304		- [ ] then
305		- if next_char is
306		- {
307		- failure then end_of_input,
308		- success(c) then
309		- if is_blank(c) then read_value else // skip blanks
310		- if is_value_char(c) then read_token([c], is_value_char) else
311		- if c = '\"' then read_quoted_string([]) else
312		- if c = ';' then semi_colon else
313		- error
314		- },
315		- [h . t] then
316		- unput_atoms <- t; h
317		- }.
318		-
319		- Reading an attribute-value pair.
320		-
321		-type AttrVal:
322		- comment(String),
323		- domain(String),
324		- max_age(String),
325		- path(String),
326		- secure,
327		- version(String).
328		-
329		-define String
330		- read_eq_value
331		- =
332		- with e = read_atom,
333		- if e is equals then
334		- (
335		- with a = read_atom,
336		- if a is token(n) then n else
337		- if a is quoted_string(s) then s else
338		- unput_atom(a); ""
339		- )
340		- else unput_atom(e); "".
341		-
342		-
343		-define Maybe(AttrVal)
344		- read_attr_val
345		- =
346		- if read_atom is semi_colon then
347		- with a = read_atom,
348		- if a is
349		- {
350		- end_of_input then failure,
351		- error then failure,
352		- comment then success(comment(read_eq_value)),
353		- domain then success(domain(read_eq_value)),
354		- max_age then success(max_age(read_eq_value)),
355		- path then success(path(read_eq_value)),
356		- secure then success(secure),
357		- version then success(version(read_eq_value)),
358		- token(_) then unput_atom(a); failure,
359		- quoted_string(_) then unput_atom(a); failure,
360		- equals then unput_atom(a); failure,
361		- colon then unput_atom(a); failure,
362		- semi_colon then unput_atom(a); failure,
363		- }
364		- else failure.
365		-
366		-
367		- Getting attributes from a List(AttrVal).
368		-
369		-define Maybe(String)
370		- get_comment
371		- (
372		- List(AttrVal) l
373		- ) =
374		- if l is
375		- {
376		- [ ] then failure,
377		- [h . t] then if h is comment(c)
378		- then success(c)
379		- else get_comment(t)
380		- }.
381		-
382		-define Maybe(String)
383		- get_domain
384		- (
385		- List(AttrVal) l
386		- ) =
387		- if l is
388		- {
389		- [ ] then failure,
390		- [h . t] then if h is domain(s)
391		- then success(s)
392		- else get_domain(t)
393		- }.
394		-
395		-define Int
396		- get_validity
397		- (
398		- List(AttrVal) l
399		- ) =
400		- if l is
401		- {
402		- [ ] then 0,
403		- [h . t] then if h is max_age(a)
404		- then if decimal_scan(a) is
405		- {
406		- failure then 0,
407		- success(n) then n+now
408		- }
409		- else get_validity(t)
410		- }.
411		-
412		-define Maybe(String)
413		- get_path
414		- (
415		- List(AttrVal) l
416		- ) =
417		- if l is
418		- {
419		- [ ] then failure,
420		- [h . t] then if h is path(p)
421		- then success(p)
422		- else get_path(t)
423		- }.
424		-
425		-define Bool
426		- get_secure
427		- (
428		- List(AttrVal) l
429		- ) =
430		- if l is
431		- {
432		- [ ] then false,
433		- [h . t] then if h is secure
434		- then true
435		- else get_secure(t)
436		- }.
437		-
438		-define Int
439		- get_version
440		- (
441		- List(AttrVal) l
442		- ) =
443		- if l is
444		- {
445		- [ ] then 0,
446		- [h . t] then if h is version(v)
447		- then if decimal_scan(v) is
448		- {
449		- failure then 0,
450		- success(n) then n
451		- }
452		- else get_version(t)
453		- }.
454		-
455		-
456		- Reading a cookie:
457		-
458		-variable String server_name = "".
459		-
460		-define Maybe(Cookie)
461		- read_cookie_n_e_v
462		- (
463		- String name,
464		- String value,
465		- List(AttrVal) so_far
466		- ) =
467		- if read_attr_val is
468		- {
469		- failure then
470		- success(cookie(
471		- *server_name,
472		- name,
473		- value,
474		- get_comment(so_far),
475		- get_domain(so_far),
476		- get_validity(so_far),
477		- get_path(so_far),
478		- get_secure(so_far),
479		- get_version(so_far)
480		- )),
481		-
482		- success(av) then read_cookie_n_e_v(name,value,[av . so_far])
483		- }.
484		-
485		-define Maybe(Cookie)
486		- read_cookie_n_e
487		- (
488		- String name
489		- ) =
490		- with a = read_value,
491		-
492		- if a is token(value) then read_cookie_n_e_v(name,value,[]) else
493		- if a is quoted_string(value) then read_cookie_n_e_v(name,value,[]) else
494		- unput_atom(a); failure.
495		-
496		-define Maybe(Cookie)
497		- read_cookie_n
498		- (
499		- String name
500		- ) =
501		- with a = read_atom,
502		- if a is equals
503		- then read_cookie_n_e(name)
504		- else unput_atom(a); failure.
505		-
506		-
507		-define Maybe(Cookie)
508		- read_cookie
509		- =
510		- with a = read_atom,
511		- if a is token(name)
512		- then read_cookie_n(name)
513		- else unput_atom(a); failure.
514		-
515		-
516		-define List(Cookie)
517		- read_cookies
518		- (
519		- List(Cookie) so_far
520		- ) =
521		- if read_cookie is
522		- {
523		- failure then so_far,
524		- success(c) then read_cookies([c . so_far])
525		- }.
526		-
527		-
528		-define List(Cookie)
529		- get_cookies
530		- (
531		- String svn,
532		- HTTP_header h
533		- ) =
534		- if h is http_header(n,v) then
535		- if to_lower(n) = "set-cookie"
536		- then (
537		- unput_atoms <- [];
538		- input <- v;
539		- index <- 0;
540		- server_name <- svn;
541		- read_cookies([])
542		- )
543		- else [].
544		-
545		-public define List(Cookie)
546		- get_cookies
547		- (
548		- String server_name,
549		- List(HTTP_header) headers
550		- ) =
551		- if headers is
552		- {
553		- [ ] then [ ],
554		- [h . t] then
555		- append(get_cookies(server_name,h),get_cookies(server_name,t))
556		- }.
557		-
558		-define List(Cookie)
559		- server_get_cookies
560		- (
561		- HTTP_header h
562		- ) =
563		- if h is http_header(n,v) then
564		- if to_lower(n) = "cookie"
565		- then (
566		- unput_atoms <- [];
567		- input <- v;
568		- index <- 0;
569		- server_name <- "";
570		- read_cookies([])
571		- )
572		- else [].
573		-
574		-public define List(Cookie)
575		- server_get_cookies
576		- (
577		- // String server_name,
578		- List(HTTP_header) headers
579		- ) =
580		- if headers is
581		- {
582		- [ ] then [ ],
583		- [h . t] then
584		- append(server_get_cookies(h), server_get_cookies(t))
585		- }.
586		-
587		-public define Maybe(Cookie)
588		- find_cookie
589		- (
590		- String name,
591		- List(Cookie) cookies
592		- )
593		- =
594		- if cookies is
595		- {
596		- [] then failure,
597		- [h . t] then
598		- if h is cookie(s, n, v, _, _, _, _, _, _) then
599		- if name = n then success(h)
600		- else find_cookie(name, t)
601		- }.
602		-
603		-public define String
604		- get_cookie_value
605		- (
606		- String name,
607		- List(Cookie) cookies
608		- )
609		- =
610		- if find_cookie(name, cookies) is
611		- {
612		- failure then "",
613		- success(c) then if c is cookie(_, _, v, _, _, _, _, _, _) then v
614		- }.
615		-
616		- * Reformating cookies. ************************************************************
617		-
618		- Cookies should be resent reformated according to the following grammar (copy-pasted
619		- from RFC 2109):
620		-
621		- cookie = "Cookie:" cookie-version
622		- 1*((";" \| ",") cookie-value)
623		- cookie-value = NAME "=" VALUE [";" path] [";" domain]
624		- cookie-version = "$Version" "=" value
625		- NAME = attr
626		- VALUE = value
627		- path = "$Path" "=" value
628		- domain = "$Domain" "=" value
629		-
630		-
631		-define HTTP_header
632		- reformat_cookie
633		- (
634		- Cookie c
635		- ) =
636		- if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then
637		- http_header("Cookie",
638		- "$Version=" + to_decimal(ver) +
639		- ";" + n + "=\"" + v + "\"" +
640		- if mbp is
641		- {
642		- failure then "",
643		- success(p) then ";$Path=\"" + p + "\""
644		- } +
645		- if mbd is
646		- {
647		- failure then "",
648		- success(d) then ";$Domain=\"" + d + "\""
649		- }
650		- ).
651		-
652		-
653		- According to RFC 2109, a cookie may be sent to a server if:
654		-
655		- (1) server name in the cookie is the name of the server,
656		- (2) if 'Path' attribute is present, its value must match the URI,
657		- (3) the cookie is still valid (validity = 0 means indefinitely valid).
658		-
659		- define Bool
660		- path_match
661		- (
662		- Maybe(String) cookie_path,
663		- String uri
664		- ) =
665		- if cookie_path is
666		- {
667		- failure then true,
668		- success(p) then
669		-
670		- }.
671		-
672		-
673		- Checking if the path matches:
674		-
675		-
676		-define Bool
677		- path_match
678		- (
679		- Maybe(String) mbp,
680		- String uri
681		- ) =
682		- true.
683		-
684		-
685		- The next function verifies if a cookie satisfies the rules.
686		-
687		-define Bool
688		- may_resend_cookie
689		- (
690		- String server_name,
691		- String uri,
692		- Cookie c
693		- ) =
694		- if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then
695		- if sn = server_name
696		- then (
697		- if path_match(mbp,uri)
698		- then (
699		- if vld = 0 then true else vld > now
700		- )
701		- else false
702		- )
703		- else false.
704		-
705		-
706		- The next function reformat all cookies which satisfy the 'resend' rules.
707		-
708		-public define List(HTTP_header)
709		- reformat_cookies
710		- (
711		- String server_name,
712		- String uri,
713		- List(Cookie) cookies
714		- ) =
715		- if cookies is
716		- {
717		- [ ] then [ ],
718		- [h . t] then
719		- if may_resend_cookie(server_name,uri,h)
720		- then [reformat_cookie(h) . reformat_cookies(server_name,uri,t)]
721		- else reformat_cookies(server_name,uri,t)
722		- }.
723		-
724		-
725		-
726		-
727		-
728		- See test_cookies.anubis for a test of this program.
729		-
730		-
731		-
732		-
733		-
734		-
735		-
736		-
737		-
	1	+
	2	+ Project The Anubis Project
	3	+
	4	+ Title Managing Cookies.
	5	+
	6	+ Copyright Copyright (c) Alain Prouté 2001.
	7	+
	8	+
	9	+ Author Alain Prouté
	10	+
	11	+
	12	+
	13	+
	14	+read tools/basis.anubis
	15	+read system/string.anubis
	16	+read CXM_common.anubis
	17	+read CXM_http_get_common.anubis
	18	+
	19	+
	20	+ Overview
	21	+ Cookies are defined in RFC 2109. Here is the corresponding Anubis type:
	22	+
	23	+ Each cookie has an server name (the name of the server who constructed the cookie), a
	24	+ name, a value, and several attributes.
	25	+
	26	+public type Cookie:
	27	+ cookie(String server_name, // of the server who sent the cookie
	28	+ String name, // of the cookie
	29	+ String value, // of the cookie
	30	+ // attributes:
	31	+ Maybe(String) comment, // cookies may have human readable comments
	32	+ Maybe(String) domain, // domain name as sent by the server
	33	+ Int validity, // cookie still valid if this is > now
	34	+ Maybe(String) path, // server path for which the cookie is valid
	35	+ Bool secure, // if true, do not send this cookie over an insecure link
	36	+ Int version). // Cookie version (normally 1: rfc 2109)
	37	+
	38	+
	39	+ Cookies are sent by servers through 'Set-Cookie' HTTP headers. The function
	40	+ 'get_cookies' retrieves a list of cookies from a list of HTTP headers.
	41	+
	42	+public define List(Cookie)
	43	+ get_cookies
	44	+ (
	45	+ String server_name, // name of server who sent the cookies
	46	+ List(HTTP_header) headers // HTTP headers sent by this server
	47	+ ).
	48	+
	49	+public define Maybe(Cookie)
	50	+ find_cookie
	51	+ (
	52	+ String name,
	53	+ List(Cookie) cookies
	54	+ ).
	55	+
	56	+
	57	+
	58	+
	59	+
	60	+ Normally, this function is used on the list of HTTP headers returned by either
	61	+ 'http_get' of 'https_get'.
	62	+
	63	+
	64	+ Before they can be sent back to their origin server, cookies must be reformated, in
	65	+ order to produce 'Cookie' HTTP headers:
	66	+
	67	+public define List(HTTP_header)
	68	+ reformat_cookies
	69	+ (
	70	+ String server_name,
	71	+ String uri,
	72	+ List(Cookie) cookies
	73	+ ).
	74	+
	75	+ The result of 'reformat_cookies' may be appended to the list of headers given as
	76	+ argument to 'http_get' or to 'https_get'.
	77	+
	78	+ In the meantime, you may examine and maybe discard cookies, you may 'save' them into a
	79	+ file, and 'retrieve' them later.
	80	+
	81	+
	82	+
	83	+
	84	+ ------- That all for the public part. -------------------------------------------------
	85	+
	86	+
	87	+ Here is the syntax of a 'Set-Cookie' header (according to RFC 2109):
	88	+
	89	+ set-cookie = "Set-Cookie:" cookies
	90	+ cookies = 1#cookie
	91	+ cookie = NAME "=" VALUE *(";" cookie-av)
	92	+ NAME = token
	93	+ VALUE = value
	94	+ value = token \| quoted-string
	95	+ cookie-av = "Comment" "=" value
	96	+ \| "Domain" "=" value
	97	+ \| "Max-Age" "=" value
	98	+ \| "Path" "=" value
	99	+ \| "Secure"
	100	+ \| "Version" "=" 1*DIGIT
	101	+
	102	+
	103	+ According to RFC 2616 (obsolating RFC 2068) defining HTTP 1.1, 'control characters' are
	104	+ 0 to 31 and DEL (127). A 'separator' is one of:
	105	+
	106	+ ( ) < > @ , ; : \ " / [ ] ? = { } 32(space) and 9(tab) "
	107	+
	108	+ Now, a token is a non empty sequence of ASCII characters (0 to 127), but not including
	109	+ any control character or any separator. As a consequence, characters admissible in a
	110	+ 'RFC 2616 token' are:
	111	+
	112	+ 33 !
	113	+ 35 to 39 # $ & '
	114	+ 42 43 * +
	115	+ 45 46 - .
	116	+ 48 to 57 0 ... 9
	117	+ 65 to 90 A ... Z
	118	+ 94 to 122 ^ _ ` a ... z
	119	+ 124 126 \| ~
	120	+
	121	+define Bool
	122	+ is_token_char
	123	+ (
	124	+ Word8 c
	125	+ ) =
	126	+ if c +< 33 then false else
	127	+ if c +< 34 then true else
	128	+ if c +< 35 then false else
	129	+ if c +< 40 then true else
	130	+ if c +< 42 then false else
	131	+ if c +< 44 then true else
	132	+ if c +< 45 then false else
	133	+ if c +< 47 then true else
	134	+ if c +< 48 then false else
	135	+ if c +< 58 then true else
	136	+ if c +< 65 then false else
	137	+ if c +< 91 then true else
	138	+ if c +< 94 then false else
	139	+ if c +< 123 then true else
	140	+ if c +< 124 then false else
	141	+ if c = 124 then true else
	142	+ c = 126.
	143	+
	144	+ value char are token added of =, (, )
	145	+
	146	+define Bool
	147	+ is_value_char
	148	+ (
	149	+ Word8 c
	150	+ ) =
	151	+ if c +< 33 then false else
	152	+ if c +< 34 then true else
	153	+ if c +< 35 then false else
	154	+ if c +< 44 then true else
	155	+ if c +< 45 then false else
	156	+ if c +< 47 then true else
	157	+ if c +< 48 then false else
	158	+ if c +< 58 then true else
	159	+ if c +< 61 then false else
	160	+ if c +< 62 then true else
	161	+ if c +< 65 then false else
	162	+ if c +< 91 then true else
	163	+ if c +< 94 then false else
	164	+ if c +< 123 then true else
	165	+ if c +< 124 then false else
	166	+ if c = 124 then true else
	167	+ c = 126.
	168	+
	169	+ From the grammar, it is clear that atomic entities (called 'tokens' by YACC) are:
	170	+
	171	+ - tokens (in the sens of RFC 2616) some of which have to be recognized as keywords
	172	+ - quoted strings
	173	+ - equal sign
	174	+ - colon
	175	+ - semi-colon
	176	+
	177	+ Hence, the following type:
	178	+
	179	+public type Atom:
	180	+ end_of_input,
	181	+ error,
	182	+ comment,
	183	+ domain,
	184	+ max_age,
	185	+ path,
	186	+ secure,
	187	+ version,
	188	+ token(String),
	189	+ quoted_string(String),
	190	+ equals,
	191	+ colon,
	192	+ semi_colon.
	193	+
	194	+
	195	+variable List(Atom) unput_atoms = [].
	196	+
	197	+define One
	198	+ unput_atom
	199	+ (
	200	+ Atom a
	201	+ ) =
	202	+ unput_atoms <- [a . *unput_atoms].
	203	+
	204	+define Atom
	205	+ recognize_keyword
	206	+ (
	207	+ String s
	208	+ ) =
	209	+ with l = to_lower(s),
	210	+ if l = "comment" then comment else
	211	+ if l = "domain" then domain else
	212	+ if l = "max-age" then max_age else
	213	+ if l = "path" then path else
	214	+ if l = "secure" then secure else
	215	+ if l = "version" then version else
	216	+ token(s).
	217	+
	218	+
	219	+variable String input = "". From which cookies will be read.
	220	+variable Int index = 0. Current position within 'input'.
	221	+
	222	+define Maybe(Word8)
	223	+ next_char
	224	+ =
	225	+ if nth(index,input) is
	226	+ {
	227	+ failure then failure,
	228	+ success(c) then
	229	+ index <- *index+1;
	230	+ success(c)
	231	+ }.
	232	+
	233	+define One
	234	+ unput_char
	235	+ =
	236	+ index <- *index-1.
	237	+
	238	+define Atom
	239	+ read_token
	240	+ (
	241	+ List(Word8) so_far, // contains at least 1 character
	242	+ (Word8) -> Bool is_valid_char
	243	+ ) =
	244	+ if next_char is
	245	+ {
	246	+ failure then recognize_keyword(implode(reverse(so_far))),
	247	+ success(c) then
	248	+ if is_valid_char(c)
	249	+ then read_token([c . so_far], is_valid_char)
	250	+ else unput_char; recognize_keyword(implode(reverse(so_far)))
	251	+ }.
	252	+
	253	+define Atom
	254	+ read_quoted_string
	255	+ (
	256	+ List(Word8) so_far
	257	+ ) =
	258	+ if next_char is
	259	+ {
	260	+ failure then quoted_string(implode(reverse(so_far))),
	261	+ success(c) then
	262	+ if c = '\"'
	263	+ then quoted_string(implode(reverse(so_far)))
	264	+ else read_quoted_string([c . so_far])
	265	+ }.
	266	+
	267	+define Bool
	268	+ is_blank
	269	+ (
	270	+ Word8 c
	271	+ ) =
	272	+ c +=< ' '.
	273	+
	274	+ Reading an atom from the input:
	275	+
	276	+define Atom
	277	+ read_atom
	278	+ =
	279	+ if *unput_atoms is
	280	+ {
	281	+ [ ] then
	282	+ if next_char is
	283	+ {
	284	+ failure then end_of_input,
	285	+ success(c) then
	286	+ if is_blank(c) then read_atom else // skip blanks
	287	+ if is_token_char(c) then read_token([c], is_token_char) else
	288	+ if c = '\"' then read_quoted_string([]) else
	289	+ if c = '=' then equals else
	290	+ if c = ':' then colon else
	291	+ if c = ';' then semi_colon else
	292	+ error
	293	+ },
	294	+ [h . t] then
	295	+ unput_atoms <- t; h
	296	+ }.
	297	+
	298	+define Atom
	299	+ read_value
	300	+ =
	301	+ if *unput_atoms is
	302	+ {
	303	+ [ ] then
	304	+ if next_char is
	305	+ {
	306	+ failure then end_of_input,
	307	+ success(c) then
	308	+ if is_blank(c) then read_value else // skip blanks
	309	+ if is_value_char(c) then read_token([c], is_value_char) else
	310	+ if c = '\"' then read_quoted_string([]) else
	311	+ if c = ';' then semi_colon else
	312	+ error
	313	+ },
	314	+ [h . t] then
	315	+ unput_atoms <- t; h
	316	+ }.
	317	+
	318	+ Reading an attribute-value pair.
	319	+
	320	+type AttrVal:
	321	+ comment(String),
	322	+ domain(String),
	323	+ max_age(String),
	324	+ path(String),
	325	+ secure,
	326	+ version(String).
	327	+
	328	+define String
	329	+ read_eq_value
	330	+ =
	331	+ with e = read_atom,
	332	+ if e is equals then
	333	+ (
	334	+ with a = read_atom,
	335	+ if a is token(n) then n else
	336	+ if a is quoted_string(s) then s else
	337	+ unput_atom(a); ""
	338	+ )
	339	+ else unput_atom(e); "".
	340	+
	341	+
	342	+define Maybe(AttrVal)
	343	+ read_attr_val
	344	+ =
	345	+ if read_atom is semi_colon then
	346	+ with a = read_atom,
	347	+ if a is
	348	+ {
	349	+ end_of_input then failure,
	350	+ error then failure,
	351	+ comment then success(comment(read_eq_value)),
	352	+ domain then success(domain(read_eq_value)),
	353	+ max_age then success(max_age(read_eq_value)),
	354	+ path then success(path(read_eq_value)),
	355	+ secure then success(secure),
	356	+ version then success(version(read_eq_value)),
	357	+ token(_) then unput_atom(a); failure,
	358	+ quoted_string(_) then unput_atom(a); failure,
	359	+ equals then unput_atom(a); failure,
	360	+ colon then unput_atom(a); failure,
	361	+ semi_colon then unput_atom(a); failure,
	362	+ }
	363	+ else failure.
	364	+
	365	+
	366	+ Getting attributes from a List(AttrVal).
	367	+
	368	+define Maybe(String)
	369	+ get_comment
	370	+ (
	371	+ List(AttrVal) l
	372	+ ) =
	373	+ if l is
	374	+ {
	375	+ [ ] then failure,
	376	+ [h . t] then if h is comment(c)
	377	+ then success(c)
	378	+ else get_comment(t)
	379	+ }.
	380	+
	381	+define Maybe(String)
	382	+ get_domain
	383	+ (
	384	+ List(AttrVal) l
	385	+ ) =
	386	+ if l is
	387	+ {
	388	+ [ ] then failure,
	389	+ [h . t] then if h is domain(s)
	390	+ then success(s)
	391	+ else get_domain(t)
	392	+ }.
	393	+
	394	+define Int
	395	+ get_validity
	396	+ (
	397	+ List(AttrVal) l
	398	+ ) =
	399	+ if l is
	400	+ {
	401	+ [ ] then 0,
	402	+ [h . t] then if h is max_age(a)
	403	+ then if decimal_scan(a) is
	404	+ {
	405	+ failure then 0,
	406	+ success(n) then n+now
	407	+ }
	408	+ else get_validity(t)
	409	+ }.
	410	+
	411	+define Maybe(String)
	412	+ get_path
	413	+ (
	414	+ List(AttrVal) l
	415	+ ) =
	416	+ if l is
	417	+ {
	418	+ [ ] then failure,
	419	+ [h . t] then if h is path(p)
	420	+ then success(p)
	421	+ else get_path(t)
	422	+ }.
	423	+
	424	+define Bool
	425	+ get_secure
	426	+ (
	427	+ List(AttrVal) l
	428	+ ) =
	429	+ if l is
	430	+ {
	431	+ [ ] then false,
	432	+ [h . t] then if h is secure
	433	+ then true
	434	+ else get_secure(t)
	435	+ }.
	436	+
	437	+define Int
	438	+ get_version
	439	+ (
	440	+ List(AttrVal) l
	441	+ ) =
	442	+ if l is
	443	+ {
	444	+ [ ] then 0,
	445	+ [h . t] then if h is version(v)
	446	+ then if decimal_scan(v) is
	447	+ {
	448	+ failure then 0,
	449	+ success(n) then n
	450	+ }
	451	+ else get_version(t)
	452	+ }.
	453	+
	454	+
	455	+ Reading a cookie:
	456	+
	457	+variable String server_name = "".
	458	+
	459	+define Maybe(Cookie)
	460	+ read_cookie_n_e_v
	461	+ (
	462	+ String name,
	463	+ String value,
	464	+ List(AttrVal) so_far
	465	+ ) =
	466	+ if read_attr_val is
	467	+ {
	468	+ failure then
	469	+ success(cookie(
	470	+ *server_name,
	471	+ name,
	472	+ value,
	473	+ get_comment(so_far),
	474	+ get_domain(so_far),
	475	+ get_validity(so_far),
	476	+ get_path(so_far),
	477	+ get_secure(so_far),
	478	+ get_version(so_far)
	479	+ )),
	480	+
	481	+ success(av) then read_cookie_n_e_v(name,value,[av . so_far])
	482	+ }.
	483	+
	484	+define Maybe(Cookie)
	485	+ read_cookie_n_e
	486	+ (
	487	+ String name
	488	+ ) =
	489	+ with a = read_value,
	490	+
	491	+ if a is token(value) then read_cookie_n_e_v(name,value,[]) else
	492	+ if a is quoted_string(value) then read_cookie_n_e_v(name,value,[]) else
	493	+ unput_atom(a); failure.
	494	+
	495	+define Maybe(Cookie)
	496	+ read_cookie_n
	497	+ (
	498	+ String name
	499	+ ) =
	500	+ with a = read_atom,
	501	+ if a is equals
	502	+ then read_cookie_n_e(name)
	503	+ else unput_atom(a); failure.
	504	+
	505	+
	506	+define Maybe(Cookie)
	507	+ read_cookie
	508	+ =
	509	+ with a = read_atom,
	510	+ if a is token(name)
	511	+ then read_cookie_n(name)
	512	+ else unput_atom(a); failure.
	513	+
	514	+
	515	+define List(Cookie)
	516	+ read_cookies
	517	+ (
	518	+ List(Cookie) so_far
	519	+ ) =
	520	+ if read_cookie is
	521	+ {
	522	+ failure then so_far,
	523	+ success(c) then read_cookies([c . so_far])
	524	+ }.
	525	+
	526	+
	527	+define List(Cookie)
	528	+ get_cookies
	529	+ (
	530	+ String svn,
	531	+ HTTP_header h
	532	+ ) =
	533	+ if h is http_header(n,v) then
	534	+ if to_lower(n) = "set-cookie"
	535	+ then (
	536	+ unput_atoms <- [];
	537	+ input <- v;
	538	+ index <- 0;
	539	+ server_name <- svn;
	540	+ read_cookies([])
	541	+ )
	542	+ else [].
	543	+
	544	+public define List(Cookie)
	545	+ get_cookies
	546	+ (
	547	+ String server_name,
	548	+ List(HTTP_header) headers
	549	+ ) =
	550	+ if headers is
	551	+ {
	552	+ [ ] then [ ],
	553	+ [h . t] then
	554	+ append(get_cookies(server_name,h),get_cookies(server_name,t))
	555	+ }.
	556	+
	557	+define List(Cookie)
	558	+ server_get_cookies
	559	+ (
	560	+ HTTP_header h
	561	+ ) =
	562	+ if h is http_header(n,v) then
	563	+ if to_lower(n) = "cookie"
	564	+ then (
	565	+ unput_atoms <- [];
	566	+ input <- v;
	567	+ index <- 0;
	568	+ server_name <- "";
	569	+ read_cookies([])
	570	+ )
	571	+ else [].
	572	+
	573	+public define List(Cookie)
	574	+ server_get_cookies
	575	+ (
	576	+ // String server_name,
	577	+ List(HTTP_header) headers
	578	+ ) =
	579	+ if headers is
	580	+ {
	581	+ [ ] then [ ],
	582	+ [h . t] then
	583	+ append(server_get_cookies(h), server_get_cookies(t))
	584	+ }.
	585	+
	586	+public define Maybe(Cookie)
	587	+ find_cookie
	588	+ (
	589	+ String name,
	590	+ List(Cookie) cookies
	591	+ )
	592	+ =
	593	+ if cookies is
	594	+ {
	595	+ [] then failure,
	596	+ [h . t] then
	597	+ if h is cookie(s, n, v, _, _, _, _, _, _) then
	598	+ if name = n then success(h)
	599	+ else find_cookie(name, t)
	600	+ }.
	601	+
	602	+public define String
	603	+ get_cookie_value
	604	+ (
	605	+ String name,
	606	+ List(Cookie) cookies
	607	+ )
	608	+ =
	609	+ if find_cookie(name, cookies) is
	610	+ {
	611	+ failure then "",
	612	+ success(c) then if c is cookie(_, _, v, _, _, _, _, _, _) then v
	613	+ }.
	614	+
	615	+ * Reformating cookies. ************************************************************
	616	+
	617	+ Cookies should be resent reformated according to the following grammar (copy-pasted
	618	+ from RFC 2109):
	619	+
	620	+ cookie = "Cookie:" cookie-version
	621	+ 1*((";" \| ",") cookie-value)
	622	+ cookie-value = NAME "=" VALUE [";" path] [";" domain]
	623	+ cookie-version = "$Version" "=" value
	624	+ NAME = attr
	625	+ VALUE = value
	626	+ path = "$Path" "=" value
	627	+ domain = "$Domain" "=" value
	628	+
	629	+
	630	+define HTTP_header
	631	+ reformat_cookie
	632	+ (
	633	+ Cookie c
	634	+ ) =
	635	+ if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then
	636	+ http_header("Cookie",
	637	+ "$Version=" + to_decimal(ver) +
	638	+ ";" + n + "=\"" + v + "\"" +
	639	+ if mbp is
	640	+ {
	641	+ failure then "",
	642	+ success(p) then ";$Path=\"" + p + "\""
	643	+ } +
	644	+ if mbd is
	645	+ {
	646	+ failure then "",
	647	+ success(d) then ";$Domain=\"" + d + "\""
	648	+ }
	649	+ ).
	650	+
	651	+
	652	+ According to RFC 2109, a cookie may be sent to a server if:
	653	+
	654	+ (1) server name in the cookie is the name of the server,
	655	+ (2) if 'Path' attribute is present, its value must match the URI,
	656	+ (3) the cookie is still valid (validity = 0 means indefinitely valid).
	657	+
	658	+ define Bool
	659	+ path_match
	660	+ (
	661	+ Maybe(String) cookie_path,
	662	+ String uri
	663	+ ) =
	664	+ if cookie_path is
	665	+ {
	666	+ failure then true,
	667	+ success(p) then
	668	+
	669	+ }.
	670	+
	671	+
	672	+ Checking if the path matches:
	673	+
	674	+
	675	+define Bool
	676	+ path_match
	677	+ (
	678	+ Maybe(String) mbp,
	679	+ String uri
	680	+ ) =
	681	+ true.
	682	+
	683	+
	684	+ The next function verifies if a cookie satisfies the rules.
	685	+
	686	+define Bool
	687	+ may_resend_cookie
	688	+ (
	689	+ String server_name,
	690	+ String uri,
	691	+ Cookie c
	692	+ ) =
	693	+ if c is cookie(sn,n,v,mbc,mbd,vld,mbp,sec,ver) then
	694	+ if sn = server_name
	695	+ then (
	696	+ if path_match(mbp,uri)
	697	+ then (
	698	+ if vld = 0 then true else vld > now
	699	+ )
	700	+ else false
	701	+ )
	702	+ else false.
	703	+
	704	+
	705	+ The next function reformat all cookies which satisfy the 'resend' rules.
	706	+
	707	+public define List(HTTP_header)
	708	+ reformat_cookies
	709	+ (
	710	+ String server_name,
	711	+ String uri,
	712	+ List(Cookie) cookies
	713	+ ) =
	714	+ if cookies is
	715	+ {
	716	+ [ ] then [ ],
	717	+ [h . t] then
	718	+ if may_resend_cookie(server_name,uri,h)
	719	+ then [reformat_cookie(h) . reformat_cookies(server_name,uri,t)]
	720	+ else reformat_cookies(server_name,uri,t)
	721	+ }.
	722	+
	723	+
	724	+
	725	+
	726	+
	727	+ See test_cookies.anubis for a test of this program.
	728	+
	729	+
	730	+
	731	+
	732	+
	733	+
	734	+
	735	+
	736	+
...	...

web/CXM_html.anubis deleted

View file @5ee747e

1		-
2		- Project The Anubis Project
3		- Title Producing HTML/Javascript code.
4		-
5		- Copyright Copyright (c) Alain Prouté 2001.
6		-
7		-read tools/basis.anubis
8		-read system/string.anubis
9		-read tools/printable_tree.anubis
10		-
11		-
12		- *** Managing Web Arguments.
13		-
14		- When a client submits a form, he sends informations to the server. This information is
15		- transformed by the server into a list of data of type 'Web_arg'. This is the reason why
16		- a 'web page' operation always has a unique argument of type 'List(Web_arg)'.
17		-
18		- The type 'Web_arg' is defined in 'web/common.anubis' as follows:
19		-
20		- public type Web_arg:
21		- web_arg(String name,
22		- String value),
23		- upload (String name,
24		- String value,
25		- String temp_file_path).
26		-
27		-read CXM_common.anubis
28		-
29		- In other words, a 'web argument' is just a pair made of the name of the argument, and
30		- the value of the argument, and both are character strings. 'upload' will be explained
31		- later.
32		-
33		-
34		- The next variable is a multipurpose counter (used to generate unique names).
35		-
36		-variable Int web_count = 0.
37		-
38		-define Int
39		- new_web_count
40		- =
41		- web_count <- *web_count+1;
42		- *web_count.
43		-
44		-
45		- Names for Web colors.
46		-
47		-public type Web_color_name:
48		- aliceblue,
49		- antiquewhite1,
50		- antiquewhite2,
51		- antiquewhite3,
52		- antiquewhite4,
53		- aquamarine1,
54		- aquamarine2,
55		- aquamarine3,
56		- aquamarine4,
57		- azure1,
58		- azure2,
59		- azure3,
60		- azure4,
61		- yellow.
62		-
63		-
64		- and so on ... (see below why I did not do more).
65		-
66		-
67		-
68		- Web colors.
69		-
70		-public type Web_color:
71		- rgb(Word8,Word8,Word8), /* give the color by its components */
72		- _(Web_color_name). /* or by its name */
73		-
74		-
75		-
76		-
77		- The following produces '<meta>' tags, which are put in the head of the document.
78		-
79		-public type WebMeta:
80		- keywords(List(String)),
81		- refresh(String url, Int delay), // in seconds
82		- meta(String name, String content),
83		- http_equiv(String name, String content).
84		-
85		-
86		-
87		-
88		-
89		- *******************************************************
90		- * Web items *
91		- * (the many kinds of things one may put in a page) *
92		- *******************************************************
93		-
94		-
95		-public type Web_item:
96		- [ ], /* empty (invisible) item */
97		- ... this is a cross recursive type.
98		-
99		-
100		-
101		-
102		- Options for web page body.
103		-
104		-public type LayerDisposition:
105		- horizontal,
106		- vertical.
107		-
108		-public type FollowPathCommand: // this type is used by the Web_body_option 'follow_path'.
109		- pos(Int x, // x coordinate of position
110		- Int y, // y coordinate of position
111		- Int image_number, // the image to display at that position
112		- Int delay). // wait that milliseconds before leaving this position
113		-
114		-public type Web_body_option:
115		- background_color(Web_color), /* color for the background */
116		- //
117		- // 'psychedelic_background' produces a background color which is continuously changing.
118		- // 'average' is the average luminosity of the color. 'amplitude' is the maximal variation
119		- // the luminosity around the average. 'delay' is the number of milliseconds between two
120		- // color changes. For example, you may try 'psychedelic_background(200,50,1000)', which
121		- // produces a background whose color changes very slowly (this is not tiring) among rather
122		- // light pastel colors.
123		- //
124		- psychedelic_background(Int average, /* average light (0 to 255) */
125		- Int amplitude, /* amplitude of variation of light */
126		- Int delay), /* in milliseconds */
127		- background_image(String file_name), /* name of image file for the background */
128		- //
129		- // 'scrolling_layer' produces a layer above the page which is scrolling continuously either
130		- // vertically or horizontally. The 'content' is indefinitly repeated.
131		- //
132		- scrolling_layer(LayerDisposition,
133		- Int steps, /* number of pixels of each move */
134		- Int margin, /* measured from left or top in pixels */
135		- Int delay, /* milliseconds for one move */
136		- Web_item content, /* content of layer (will be repeated) */
137		- Int period), /* number of pixels between two instances of 'content' */
138		- //
139		- // 'bounce' shows its content above the page and let it move and bounce on the edges of a rectangle.
140		- // The rectangle is determined by the last 4 arguments.
141		- //
142		- bounce(Web_item content,
143		- Int left,
144		- Int right,
145		- Int top,
146		- Int bottom),
147		- //
148		- // put something over the page in any position you want:
149		- //
150		- over(Web_item content,
151		- Int left,
152		- Int top),
153		- //
154		- // follow_path: let a changing image follow a path on the screen. This gadget shows
155		- // an image following a polygonal path on the screen. The image may change at regular
156		- // intervals, thus providing extra animation. The images are displayed in the order
157		- // they are given in the first argument. When the last image has been displayed, the
158		- // first image is displayed again, and so on. The path is a sequence of absolute positions
159		- // on screen (actually in the browser's window or frame), which is followed in the
160		- // order given in the 'path' argument. If 'loop' is true, the path is followed again and again.
161		- // Otherwise, it is followed only once. If you want to make a closed loop, the last
162		- // position must be the same as the first one. 'steps' is the number of pixels of distance
163		- // between two successive positions of the image, and 'delay' the number of milliseconds
164		- // between two successive positions. 'change_every' is the number of steps (a 'step' is
165		- // passing from one position to the next one) after which the displayed image is replaced
166		- // by the next image.
167		- //
168		- // Each position 'pos(x,y,i,d)' has 4 parameters. 'x' and 'y' are the coordinates of the
169		- // position in the browser's window or frame. 'i' is the number of the image to display
170		- // at this position (i.e. the rank of the image in the list 'filename'. The first one has
171		- // rank 0). 'd' is the delay in milliseconds to wait before leaving that position.
172		- //
173		- follow_path(List(String) filenames, /* the changing images which follows the path */
174		- Int change_every, /* number of steps betwen two changes */
175		- List(FollowPathCommand) path, /* the polygonal path and commands */
176		- Bool loop, /* if true do it repeatedly, otherwise only once */
177		- Int steps, /* approximative distance (in pixels) between two
178		- successive positions */
179		- Int delay), /* milliseconds between two successive positions */
180		-
181		- load_image(String name), /* load an image (for next page), which is not displayed */
182		- left_margin(Int), /* left margin for document */
183		- top_margin(Int), /* top margin for document */
184		- margin_width(Int),
185		- margin_height(Int),
186		- reload_frame(String name, /* name of target frame */
187		- String url), /* url to load in this frame */
188		- onload(String function_name). /* nom de la fonction javascript (sans les '()') */
189		-
190		-public type BodyOnload:
191		- reload_frame(String name, String url).
192		-
193		-variable List(BodyOnload) body_onloads = [ ].
194		-
195		-define One
196		- add_body_onload
197		- (
198		- BodyOnload item
199		- ) =
200		- body_onloads <- [item . *body_onloads].
201		-
202		-define Printable_tree
203		- format
204		- (
205		- BodyOnload item
206		- ) =
207		- if item is
208		- {
209		- reload_frame(name,url) then (Printable_tree)
210		- [ " window.open('",url,"','",name,"');" ]
211		- }.
212		-
213		-define Printable_tree
214		- format
215		- (
216		- List(BodyOnload) l
217		- ) =
218		- if l is
219		- {
220		- [ ] then (Printable_tree)[ ],
221		- [h . t] then (Printable_tree)
222		- [format(h) . format(t)]
223		- }.
224		-
225		-
226		----- Body of a web page. --------------------------------------------
227		-public type Page_body:
228		- body(List(Web_body_option), /* list of body options */
229		- Web_item content). /* the content of the page */
230		-
231		-
232		-public type VFrame:
233		- frame(Int height,
234		- Printable_tree url,
235		- String name).
236		-
237		----- Web pages. -----------------------------------------------------
238		-public type Web_page:
239		- web_page(String title, /* title appearing on top of browser */
240		- List(WebMeta) meta_tags,
241		- Printable_tree head_scripts, /* scripts à placer dans la balise head */
242		- Page_body body), /* body of page */
243		- standard_frameset(String title,
244		- List(WebMeta) meta_tags,
245		- Int height, /* height of 'top menu' (pixels) */
246		- Int width, /* width of 'left menu' (pixels) */
247		- Printable_tree main). /* url for main */
248		-
249		- +---------+--------------------------+
250		- \| \| ^ \|
251		- \|<-width->\| top height \|
252		- \| \| v \|
253		- \| left +--------------------------+
254		- \| \| \|
255		- \| \| main \|
256		- \| \| \|
257		- \| \| \|
258		- \| \| \|
259		- +---------+--------------------------+
260		-
261		- Note: top and left frames must be loaded through the Web_body_option 'reload_frame'.
262		-
263		-
264		-public define Web_page
265		- web_page
266		- (
267		- String title,
268		- Page_body body
269		- ) =
270		- web_page(title,[],[], body).
271		-
272		-public define Web_page
273		- web_page
274		- (
275		- String title,
276		- List(WebMeta) meta_tags,
277		- Page_body body
278		- ) =
279		-
280		- web_page(title, meta_tags, [], body).
281		-
282		- public define Web_page
283		-web_page
284		- (
285		- String title,
286		- Printable_tree head_scripts,
287		- Page_body body
288		- ) =
289		-
290		- web_page(title, [], head_scripts, body).
291		-
292		-public define Web_page
293		-standard_frameset
294		- (
295		- String title,
296		- Int height,
297		- Int width,
298		- Printable_tree main
299		- ) =
300		-
301		- standard_frameset(title, [], height, width, main).
302		-
303		-
304		-variable Printable_tree scripts = [].
305		-
306		-define One
307		- add_script
308		- (
309		- Printable_tree script
310		- ) =
311		- scripts <- [*scripts . script].
312		-
313		-
314		-
315		- ---- Non empty web items. -------------------------------------------
316		-
317		- We have already seen the empty web item. Together with the following one, it enables to
318		- make (pseudo-)lists of web items, which will be presented one after the other (from
319		- left to right) in the browser's window.
320		-
321		-public type Web_item:
322		- [Web_item . Web_item],...
323		-
324		-
325		- A web item may be a simple string or a simple integer:
326		-
327		-public type Web_item:
328		- text(String),
329		- text_pt(Printable_tree),
330		- text_nowrap(String),
331		- text_nowrap_pt(Printable_tree),
332		- par(String),
333		- preformated_text(String text),
334		- integer(Int),
335		- float(Float,Int),...
336		-
337		-
338		- You may want to center a web item in a page. Just enclose it into
339		- 'center(...)':
340		-
341		-public type Web_item:
342		- center(Web_item),...
343		-
344		-
345		- You may want to write characters of a given item with a big font:
346		-
347		-public type Web_item:
348		- bigger(Int,Web_item),
349		- smaller(Int,Web_item),
350		- bold(Web_item),
351		- italic(Web_item),
352		- big(Web_item),
353		- very_big(Web_item),...
354		-
355		-
356		- Most of the previous are subsumed by 'style':
357		-
358		-public type WebStyle:
359		- background_image(String file_name),
360		- background_color(Web_color color),
361		- background_transparent,
362		- background_repeat_horizontal, // repeat the background image only horizontally
363		- background_repeat_vertical,
364		- background_no_repeat,
365		- color(Web_color color),
366		- float_to_left, // the web item will float to the left and text will wrap around
367		- float_to_right,
368		- font_family(String font_name), // "verdana" "helvetica" "times" etc...
369		- font_size(Int size),
370		- italic,
371		- oblique,
372		- small_capitals,
373		- bold,
374		- bolder,
375		- lighter,
376		- line_height(Int height),
377		- text_center,
378		- text_left,
379		- text_right,
380		- text_justify,
381		- text_underline,
382		- text_blink,
383		- text_line_through,
384		- width(Int n).
385		-
386		-
387		-
388		-public type Web_item:
389		- style(List(WebStyle) styles, Web_item content),...
390		-
391		-
392		-public type Web_item:
393		- spacer(Int width, Int height),
394		- image(String file_name), /* image */
395		- image_d(String file_name, String description),
396		- image_pt(Printable_tree file_name),
397		- on_image(String file_name, Web_item content),
398		- turning_images(NonEmptyList(String) filenames, Int millisecs),...
399		-
400		-
401		-
402		- A 'rollover' has the same role as a submit button or link, but it is prettier. It is
403		- made of two images. The first one 'image_on' determines the aspect of the button when
404		- the mouse cursor is on it. The other one 'image_off' determines the aspect of the
405		- button when the mouse cursor is anywhere else. The two images should be of the same
406		- size, otherwise bad effects may occur. The last operand 'description' is a small text
407		- which describes the role of the button. It appears in a bubble in the browser's window.
408		-
409		-public type Web_item:
410		- rollover(List(String) preload_images, // images to preload before the rollover is effective
411		- String url, // URL with possible web arguments
412		- String target,
413		- String image_on, // file name of 'highlighted' image
414		- String image_off, // file name of 'non highlighted' image
415		- String description), // short behavior description
416		- rollover(List(String) preload_images,
417		- String url,
418		- String target,
419		- String image_on,
420		- String image_off,
421		- Int width,
422		- Int height,
423		- String description), ...
424		-
425		-
426		- Mouse sensitive images are images with predefined zones which are clickable. When
427		- clicking in a zone, the specified corresponding URL is loaded by the browser. If two
428		- zones overlap, the first one (in the order they are defined) is selected.
429		-
430		- Zones are of 3 sorts: rectangles, circles and polygons. Point's coordinates are
431		- specified as pairs of integers (of anonymous agglomeration type (Int,Int)). The
432		- first coordinate counts pixels from the left of the image. The second coordinate counts
433		- pixels from the top of the image. With polygons, you can construct zones which are
434		- almost as complicated as you want. You may also construct a zone as the overlapping of
435		- several zones with the same URL.
436		-
437		-public type Mouse_Sensitive_Zone:
438		- rectangle
439		- (
440		- (Int,Int) left_top,
441		- (Int,Int) right_bottom,
442		- String url
443		- ),
444		- circle
445		- (
446		- (Int,Int) center,
447		- Int radius,
448		- String url
449		- ),
450		- polygon
451		- (
452		- List((Int,Int)) vertices,
453		- String url
454		- ).
455		-
456		-public type Web_item:
457		- mouse_sensitive_image(String image_file_name, // the image itself
458		- List(Mouse_Sensitive_Zone) zones),...
459		-
460		-
461		- In project: mouse sensitive images, whose zones behave like submission buttons (to be
462		- used within a form).
463		-
464		-
465		-public type Web_item:
466		- background_sound(String sound_file_name,
467		- Bool loop),...
468		-
469		-
470		-
471		- *************************
472		- * FORMS *
473		- *************************
474		-
475		-
476		- Use 'forms' in order to get informations back from the client. The constructor 'form'
477		- take 2 arguments:
478		-
479		- - the name of the form, which must be the name of an Anubis web
480		- page. Indeed, when the user will submit the form, this page will
481		- be sent to him.
482		- - the content of the form, which may be any web item, but which
483		- normally (amongh other things) contains input fields and a
484		- submit button.
485		-
486		-public type Web_item:
487		- form(Printable_tree name,
488		- Web_item content),
489		- form_target(Printable_tree name,
490		- Web_item content,
491		- String target),
492		- form(Printable_tree name,
493		- String label_name,
494		- Web_item content),
495		- form_name(String form_name, // option name de form
496		- Web_item content),...
497		-
498		- public define Web_item
499		-form
500		- (
501		- Printable_tree name,
502		- Web_item content
503		- ) =
504		-
505		- form("", name, content).
506		-
507		- Within a form, you may put 'text input fields', that the client may
508		- edit. The constructor 'text_input' has the following arguments:
509		-
510		- - name of input field. This will be the name of the correponding
511		- web argument in the Anubis web page referred to by the form.
512		- - size of field (as it appears on client screen),
513		- - initial value of field (the text that appears in the field, when
514		- the client downloads the page).
515		-
516		-
517		- public type Text_Input_Option
518		-
519		-public type Web_item:
520		- text_input(String name, /* text field to be documented by user */
521		- Int size,
522		- String initial_value),...
523		-
524		- public define Web_item
525		- text_input
526		- (
527		- String name,
528		- Int size,
529		- String initial_value
530		- ) =
531		-
532		-
533		- text_input( (List(Text_Input_Option)) [], name, size, initial_value).
534		-
535		-
536		-public type Web_item:
537		- password_input(String name,
538		- Int size),
539		- text_area(String name,
540		- Int columns,
541		- Int rows,
542		- String initial_text),
543		- upload(String name, Int size),...
544		-
545		-
546		-
547		-
548		-public type Web_item:
549		- submit(String button_text), /* submit button with text on it */
550		- submit_pt(Printable_tree button_text),
551		- submit(String name, String text),
552		- submit_close(String name, String text),
553		- submit_pt2(String name, Printable_tree text),
554		- image_submit(String name, String image_file_name),
555		- image_submit(String name, String value, String image_file, Web_item content),
556		- hl_image_submit(String action_name,
557		- String value,
558		- String image_name,
559		- String image_file,
560		- String hl_image_file),
561		- text_submit(String name, String value, String text),
562		- web_submit(String web_args, Web_item content),
563		- button(String name, String text, String on_click_fonction, Int width, Int height),...
564		-
565		-
566		-public type Web_item: /* mark the form with an information */
567		- mark(String name, String value),
568		- mark_pt(String name, Printable_tree value),...
569		-
570		-public type Web_item:
571		- close_button, /* button that closes the window */
572		- close_button(String image_file_name), ...
573		-
574		-
575		-
576		- *********************************
577		- * LABELS *
578		- *********************************
579		-
580		-
581		- A 'label' is just a name that you may give to a position in a document. Use the
582		- following invisible Web_item 'label' to this end. Now, you can also create links in
583		- the same document, which, when clicked by the user, scroll the document, so that the
584		- position whose name is the given label is shown just at the top of the browser's
585		- window.
586		-
587		-public type Web_item:
588		- label(String label_name), /* give a name to a position in the page */
589		- go_to_label(String label_name, /* a link for jumping to a label */
590		- Web_item content),...
591		-
592		-
593		-
594		- ********************************
595		- * TABLES *
596		- ********************************
597		-
598		-
599		- A web item may be a table. A table is produced by the constructor
600		- 'table' from the type 'Web_item'. This constructor takes 2
601		- arguments:
602		-
603		- - a list of 'table options',
604		- - a list of 'table rows'.
605		-
606		- Of course, you use as many options as you want, including
607		- none (if you do not want any option, put the empty list '[ ]' as
608		- this argument). Some options have precedence over others. For example
609		- a background image will hide the background color.
610		-
611		- Table options are defined below:
612		-
613		-public type Table_option:
614		-
615		- /* use a color as a background for the table, if you want it to
616		- be different from the background of the page */
617		- background_color(Web_color),
618		-
619		- /* or use an image as the background of the table */
620		- background_image(String file_name),
621		-
622		- /* draw a border line around the table (and around each cell in
623		- the table). You may also specify a geometry (in pixels) for the
624		- border. This makes the 'in relief' part of the border appear
625		- more or less wide. You may also specify a color for the border. */
626		- border,
627		- nude, /* equivalent to 'border(0,0,0)' (below) */
628		- border(Int, /* width of exterior (pixels) */
629		- Int, /* width of top */
630		- Int), /* width of interior */
631		- border_color(Web_color),
632		- absolute_width(Int).
633		-
634		-
635		-
636		- A 'table row' is made of a list of 'row options', and a list of
637		- 'cells'. A 'cell' itself has a list of 'cell options', and a web item,
638		- which is its content. We begin by the description of options.
639		-
640		-
641		-public type Row_option:
642		- /* following concerns the horizontal positions of items within the
643		- cells of the row */
644		- left,
645		- h_center,
646		- right,
647		- /* the following concerns the vertical positions of items, within
648		- the cells of the row */
649		- top,
650		- v_center,
651		- bottom,
652		- absolute_height(Int),
653		- base_line,
654		- /* set the background color of all cells in the row */
655		- background_color(Web_color).
656		-
657		-
658		-
659		-public type Cell_option:
660		- /* all row options are available for individual cells, and apply
661		- here only to one cell. */
662		- left,
663		- h_center,
664		- right,
665		- top,
666		- v_center,
667		- bottom,
668		- base_line,
669		- background_color(Web_color),
670		- /* you can set the width of the cell either absolutely (in pixels)
671		- or as a percentage of the width of the table. */
672		- background_image(String file_name),
673		- absolute_width(Int),
674		- relative_width(Int),
675		- absolute_height(Int),
676		- relative_height(Int),
677		- /* a cell may span over several columns or rows in the table */
678		- columns(Int),
679		- rows(Int),
680		- nowrap.
681		-
682		-
683		-public type Cell:
684		- cell(List(Cell_option),
685		- Web_item).
686		-
687		-public type Table_row:
688		- row(List(Row_option),
689		- List(Cell)).
690		-
691		-public define Table_row row(Web_item i) = row([],[cell([],i)]).
692		-public define Table_row row(Cell c) = row([],[c]).
693		-public define Table_row row(List(Cell) l) = row([],l).
694		-
695		-
696		-public type Web_item:
697		- table(List(Table_option),
698		- List(Table_row)),...
699		-
700		-public type Web_item:
701		- list(List(Web_item)),...
702		-
703		-public type Web_item:
704		- link(String name, Web_item),
705		- link(String name, String target, Web_item),...
706		-
707		-public type Web_item:
708		- link_for_download(String filename, Web_item),... // the filename is relative to the public directory
709		-
710		-public type Web_item:
711		- mail_to(String addr, Web_item),...
712		-
713		-
714		-public type Web_item:
715		- select(String name,
716		- Int size,
717		- List(String) choices),
718		- select(String name,
719		- Int size,
720		- List(String) choices,
721		- String selected),
722		- immediate_select(String name, // selection will immediately submit the form
723		- Int size,
724		- List(String) choices),...
725		-
726		-
727		-public type Web_item:
728		- radio_button (Printable_tree name, String value),
729		- checked_radio_button (Printable_tree name, String value),
730		- check_box (Printable_tree name, String value),
731		- checked_box (Printable_tree name, String value),...
732		-
733		-
734		-public type Web_item:
735		- link_to_window(Printable_tree name, Web_item),
736		- link_to_window(Printable_tree name, String window_name, Web_item),
737		- link_to_window_with_ticket(String name,
738		- String web_args,
739		- String window_name,
740		- Web_item content,
741		- Int width,
742		- Int height),
743		- link_to_window_with_ticket_and_scroll
744		- (String name,
745		- String web_args,
746		- String window_name,
747		- Web_item content,
748		- Int width,
749		- Int height),
750		- link_to_window_with_ticket_and_scroll
751		- (String name,
752		- String label_name,
753		- String web_args,
754		- String window_name,
755		- Web_item content,
756		- Int width,
757		- Int height),
758		- link_to_frame (Printable_tree name, String frame_name, Web_item).
759		-
760		-
761		-
762		----- Formating operations (Anubis --> HTML/Javascript) ---------------------------
763		-
764		- Stupid operation formating a web color name.
765		-
766		-public define String
767		- format
768		- (
769		- Web_color_name n
770		- ) =
771		- if n is
772		- {
773		- aliceblue then "aliceblue",
774		- antiquewhite1 then "antiquewhite1",
775		- antiquewhite2 then "antiquewhite2",
776		- antiquewhite3 then "antiquewhite3",
777		- antiquewhite4 then "antiquewhite4",
778		- aquamarine1 then "aquamarine1",
779		- aquamarine2 then "aquamarine2",
780		- aquamarine3 then "aquamarine3",
781		- aquamarine4 then "aquamarine4",
782		- azure1 then "azure1",
783		- azure2 then "azure2",
784		- azure3 then "azure3",
785		- azure4 then "azure4",
786		- yellow then "yellow",
787		- }.
788		-
789		- Anubis really needs some system of 'macros' to avoid this...
790		-
791		-
792		- Formating a web color.
793		-
794		-public define String
795		- format
796		- (
797		- Web_color wc
798		- ) =
799		- if wc is
800		- {
801		- rgb(r,g,b) then "\"#" + to_hexa(r) + to_hexa(g) + to_hexa(b) + "\"",
802		- _(c) then format(c)
803		- }.
804		-
805		-public define String
806		- format_without_quotes
807		- (
808		- Web_color wc
809		- ) =
810		- if wc is
811		- {
812		- rgb(r,g,b) then "#" + to_hexa(r) + to_hexa(g) + to_hexa(b) + "",
813		- _(c) then format(c)
814		- }.
815		-
816		-define Printable_tree
817		- format
818		- (
819		- Web_color c
820		- ) = [(String)format(c)].
821		-
822		-public define String
823		- format_without_sharp
824		- (
825		- Web_color wc
826		- ) =
827		- if wc is
828		- {
829		- rgb(r,g,b) then "" + to_hexa(r) + to_hexa(g) + to_hexa(b) + "",
830		- _(c) then format(c)
831		- }.
832		-
833		-define Printable_tree
834		- format_without_sharp
835		- (
836		- Web_color c
837		- ) = [(String)format_without_sharp(c)].
838		-
839		-
840		- define Printable_tree
841		- [Word32 x . Printable_tree t]
842		- =
843		- [to_Int(x) . t].
844		-
845		-define Printable_tree
846		- psychedelic_bg
847		- (
848		- Int average,
849		- Int amplitude,
850		- Int delay
851		- ) =
852		- with ampl = if amplitude >= 120 then 120 else
853		- if amplitude =< 1 then 1 else amplitude,
854		- with aver = if average+ampl >= 254 then 254-ampl
855		- else if average-ampl =< 1 then 1+ampl else average,
856		- [ "<script>",
857		- " var psy_t = 0;",
858		- " function do_psy_bg() { psy_t += 0.05;",
859		- " document.bgColor = '#' + ",
860		- " (Math.round(",aver,"+",ampl,"*Math.cos(psy_t))).toString(16) + ",
861		- " (Math.round(",aver,"+",ampl,"*Math.sin(psy_t))).toString(16) + ",
862		- " (Math.round(",aver,"-",ampl,"Math.cos(2psy_t))).toString(16); ",
863		- " setTimeout(\"do_psy_bg()\",",delay,"); }",
864		- " setTimeout(\"do_psy_bg()\",1000);",
865		- "</script>"].
866		-
867		-
868		-define List(Web_body_option)
869		- replace_background_init
870		- (
871		- List(Web_body_option) l,
872		- Int average,
873		- Int amplitude,
874		- Int delay
875		- ) =
876		- if l is
877		- {
878		- [ ] then [ ],
879		- [h . t] then
880		- if h is background_color(_)
881		- then [background_color(rgb(truncate_to_Word8(average+amplitude),
882		- truncate_to_Word8(average),
883		- truncate_to_Word8(average-amplitude)))
884		- . replace_background_init(t,average,amplitude,delay)]
885		- else [h . replace_background_init(t,average,amplitude,delay)]
886		- }.
887		-
888		-define Maybe((Int,Int,Int))
889		- get_psy
890		- (
891		- List(Web_body_option) l
892		- ) =
893		- if l is
894		- {
895		- [ ] then failure,
896		- [h . t] then
897		- if h is psychedelic_background(a,f,d)
898		- then success((a,f,d))
899		- else get_psy(t)
900		- }.
901		-
902		-define List(Web_body_option)
903		- prepare
904		- (
905		- List(Web_body_option) l
906		- ) =
907		- if get_psy(l) is
908		- {
909		- failure then l,
910		- success(op) then if op is (a,f,d) then
911		- replace_background_init(l,a,f,d)
912		- }.
913		-
914		-
915		-public define Printable_tree
916		- format
917		- (
918		- String c_ticket,
919		- String s_ticket,
920		- Web_item i
921		- ).
922		-
923		-define Printable_tree
924		- move_layer_command
925		- (
926		- String property,
927		- Int n,
928		- Int num,
929		- Int i,
930		- Int period
931		- ) =
932		- if i >= num then [ ] else
933		- [" if (document.layers)",
934		- " { document.nslay",n,"_",i,".",property,"=layp",n,"+(",((i-1)),"); } ",
935		- " else ",
936		- " { ielay",n,"_",i,".style.",property,"=layp",n,"+(",(i-1)*period,"); } "
937		- . move_layer_command(property,n,num,i+1,period)].
938		-
939		-define Printable_tree
940		- format_layers
941		- (
942		- LayerDisposition disp,
943		- Int margin,
944		- Web_item content,
945		- Int n,
946		- Int num,
947		- Int i,
948		- Int period
949		- ) =
950		- if i >= num then [ ] else
951		- ["<layer name=\"nslay",n,"_",i,"\" top=0",
952		- " left=0", ">",
953		- "<div id=ielay",n,"_",i," style=\"position:absolute;top:",
954		- if disp is vertical then (i-1)*period else margin,
955		- "px;left:",
956		- if disp is vertical then margin else (i-1)*period,
957		- "px\">",
958		- format("","",content),
959		- "</div></layer>" . format_layers(disp,margin,content,n,num,i+1,period)].
960		-
961		-define Printable_tree
962		- s_layer
963		- (
964		- LayerDisposition disp,
965		- Int steps,
966		- Int margin,
967		- Int delay,
968		- Web_item content,
969		- Int period,
970		- Int num
971		- ) =
972		- with n = new_web_count,
973		- [ "<script>",
974		- " var layp",n," = 0;",
975		- " function scroll_layer",n,"() {",
976		- " layp",n,"+=(",steps,"); if (layp",n," ",if steps > 0 then ">" else "<",
977		- "= ",if steps > 0 then period else 0,
978		- ") layp",n," = ",if steps > 0 then 0 else period,";",
979		- move_layer_command(if disp is vertical then "top" else "left",n,num,0,period),
980		- " setTimeout(\"scroll_layer",n,"()\",",delay,");",
981		- " }",
982		- " setTimeout(\"scroll_layer",n,"()\",1000);",
983		- "</script>",
984		- format_layers(disp,margin,content,n,num,0,period),
985		- ].
986		-
987		-
988		-define Printable_tree
989		- over
990		- (
991		- Web_item i,
992		- Int left,
993		- Int top
994		- ) =
995		- with n = new_web_count,
996		- [ "<layer name=\"nslay",n,"\" top=",top," left=",left,">",
997		- " <div id=\"ielay",n,"\" style=\"position:absolute;top=",top,"px;left=",left,"px\">",
998		- format("","",i),
999		- "</div></layer>"
1000		- ].
1001		-
1002		-define Printable_tree
1003		- bnce
1004		- (
1005		- Web_item i,
1006		- Int left,
1007		- Int right,
1008		- Int top,
1009		- Int bottom
1010		- ) =
1011		- with n = new_web_count,
1012		- [ "<script>",
1013		- " var bncx",n," = ",left,"; var bncy",n," = ",top,"; var bncdx",n," = 1; var bncdy",n," = 1;",
1014		- " function do_bnc",n,"() {",
1015		- " if (bncx",n," >= (",right,") \|\| bncx",n," < ",left,") bncdx",n," = -bncdx",n,";",
1016		- " if (bncy",n," >= (",bottom,") \|\| bncy",n," < ",top,") bncdy",n," = -bncdy",n,";",
1017		- " bncx",n," += bncdx",n,"; bncy",n," += bncdy",n,";",
1018		- " if (document.layers)",
1019		- " { document.nslay",n,".left = bncx",n,"; document.nslay",n,".top = bncy",n,"; } else",
1020		- " { ielay",n,".style.left = bncx",n,"; ielay",n,".style.top = bncy",n,"; }",
1021		- " setTimeout(\"do_bnc",n,"()\",40); }",
1022		- " setTimeout(\"do_bnc",n,"()\",1000);",
1023		- "</script>",
1024		- "<layer name=\"nslay",n,"\" top=",top," left=",left,">",
1025		- " <div id=\"ielay",n,"\" style=\"position:absolute;top=",top,"px;left=",left,"px\">",
1026		- format("","",i),
1027		- "</div></layer>"
1028		- ].
1029		-
1030		-
1031		-define Printable_tree
1032		- folp_switch
1033		- (
1034		- Int n,
1035		- Int i,
1036		- List(FollowPathCommand) path,
1037		- Bool loop,
1038		- Int steps
1039		- ) =
1040		- if path is
1041		- {
1042		- [ ] then [ ],
1043		- [p0 . t0] then if p0 is pos(x0,y0,i0,d0) then
1044		- if t0 is
1045		- {
1046		- [ ] then if loop
1047		- then [" default: ",
1048		- " folpx",n,"=",x0,"; folpy",n,"=",y0,"; ",
1049		- " folpseg",n,"=0; ",
1050		- " folpwait",n,"=",d0,";",
1051		- " if(document.layers)",
1052		- " document.nslay",n,".document.folpim",n,".src=folpimages",n,"[",i0,"].src;",
1053		- " else document.folpim",n,".src=folpimages",n,"[",i0,"].src;",
1054		- " folpstpmax",n," = 0;",
1055		- " folpstp",n,"=0;",
1056		- " folpdx",n,"=0; ",
1057		- " folpdy",n,"=0; ",
1058		- " break;"]
1059		- else [" default: folpend",n,"=1; break; "],
1060		- [p1 . t1] then if p1 is pos(x1,y1,i1,d1) then
1061		- [ " case ",i,": ",
1062		- " folpx",n,"=",x0,"; folpy",n,"=",y0,"; ",
1063		- " folpseg",n,"=",i+1,"; ",
1064		- " folpwait",n,"=",d0,";",
1065		- " if(document.layers)",
1066		- " document.nslay",n,".document.folpim",n,".src=folpimages",n,"[",i0,"].src;",
1067		- " else document.folpim",n,".src=folpimages",n,"[",i0,"].src;",
1068		- " folpstpmax",n," = ",
1069		- "Math.round(Math.sqrt(Math.pow(",x1,"-",x0,",2)+Math.pow(",y1,"-",y0,",2))/",steps,");",
1070		- " folpstp",n,"=0;",
1071		- " folpdx",n,"=((",x1,"-",x0,")/folpstpmax",n,"); ",
1072		- " folpdy",n,"=((",y1,"-",y0,")/folpstpmax",n,"); ",
1073		- " break; "
1074		- . folp_switch(n,i+1,t0,loop,steps) ]
1075		- }}.
1076		-
1077		-define Printable_tree
1078		- set_folpimages
1079		- (
1080		- Int n,
1081		- List(String) filenames,
1082		- Int i,
1083		- ) =
1084		- if filenames is
1085		- {
1086		- [ ] then [ ],
1087		- [h . t] then
1088		- [ " folpimages",n,"[",i,"].src=\"",h,"\";"
1089		- . set_folpimages(n,t,i+1)]
1090		- }.
1091		-
1092		-define Printable_tree
1093		- follow_path
1094		- (
1095		- List(String) filenames,
1096		- Int change_every,
1097		- List(FollowPathCommand) path,
1098		- Bool loop,
1099		- Int steps,
1100		- Int delay
1101		- ) =
1102		- if filenames is
1103		- {
1104		- [ ] then (print("Error in usage of 'follow_path': 'filenames' must be non empty."); []),
1105		- [im1 . other_ims] then
1106		- if steps < 1 then (print("Error in usage of 'follow_path': 'step' must be >= 1."); [ ]) else
1107		- if path is
1108		- {
1109		- [ ] then [ ],
1110		- [p0 . t0] then if p0 is pos(x0,y0,i0,d0) then
1111		- if t0 is
1112		- {
1113		- [ ] then
1114		- (print("Error in usage of 'follow_path': 'path' must have at least 2 positions."); []),
1115		- [p1 . t1] then if p1 is pos(x1,y1,i1,d1) then
1116		- with n = new_web_count,
1117		- [
1118		- "<layer name=\"nslay",n,"\" top=",y0," left=",x0,">",
1119		- "<div id=\"ielay",n,"\" style=\"position:absolute;top=",y0,"px;left=",x0,"px\">",
1120		- "<img src=\"",im1,"\" name=\"folpim",n,"\" border=0>",
1121		- "</div></layer>",
1122		- "<script>",
1123		- " var folpimages",n,"=new Array(",length(filenames),");",
1124		- " var folpcurim",n,"=0;",
1125		- " var folpx",n," = ",x0,";",
1126		- " var folpy",n," = ",y0,";",
1127		- " var folpseg",n," = 1;",
1128		- " var folpstpmax",n," = ",
1129		- "Math.round(Math.sqrt(Math.pow(",x1,"-",x0,",2)+Math.pow(",y1,"-",y0,",2))/",steps,");",
1130		- " var folpdx",n,"=((",x1,"-",x0,")/folpstpmax",n,"); ",
1131		- " var folpdy",n,"=((",y1,"-",y0,")/folpstpmax",n,"); ",
1132		- " var folpstp",n," = 0;",
1133		- " var folpchgcnt",n," = 0;",
1134		- " var folpwait",n,"=",d0,";",
1135		- " var folpend",n,"=0;",
1136		- " for(var i = 0; i<",length(filenames),"; i++) {",
1137		- " folpimages",n,"[i]=new Image(); }",
1138		- set_folpimages(n,filenames,0),
1139		- " function dofolp",n,"() {",
1140		- " if (folpstp",n," >= folpstpmax",n,")",
1141		- " { switch(folpseg",n,") {",
1142		- folp_switch(n,0,path,loop,steps),
1143		- " }} else { folpstp",n,"++; folpx",n," += folpdx",n,"; folpy",n," += folpdy",n,"; };",
1144		- " if (document.layers)",
1145		- " { document.nslay",n,".left=folpx",n,"; document.nslay",n,".top=folpy",n,"; } else",
1146		- " { ielay",n,".style.left=folpx",n,"; ielay",n,".style.top=folpy",n,"; };",
1147		-
1148		- //--- change image if needed:
1149		- if change_every = 0 then [ ] else
1150		- if length(filenames) =< 1 then [ ] else
1151		- [" if (folpchgcnt",n,"==",change_every,") ",
1152		- " { ",
1153		- " folpchgcnt",n,"=0;",
1154		- " folpcurim",n,"++;",
1155		- " if (folpcurim",n,"==",length(filenames),") folpcurim",n,"=0;",
1156		- " if (document.layers) ",
1157		- " document.nslay",n,".document.folpim",n,".src=folpimages",n,"[folpcurim",n,"].src;",
1158		- " else document.folpim",n,".src=folpimages",n,"[folpcurim",n,"].src;",
1159		- " }",
1160		- " else { folpchgcnt",n,"++; };"],
1161		-
1162		- " if (!folpend",n,")",
1163		- " if (folpstp",n,") setTimeout(\"dofolp",n,"()\",",delay,"); ",
1164		- " else setTimeout(\"dofolp",n,"()\",",delay,"+folpwait",n,"); ",
1165		- " }",
1166		- " setTimeout(\"dofolp",n,"()\",1000);",
1167		- "</script>",
1168		- ]
1169		- }}}.
1170		-
1171		-
1172		-public type ImageToLoad:
1173		- simple(String image_name),
1174		- with_rollover(String image_name,
1175		- String rollover_name).
1176		-
1177		-variable List(ImageToLoad) images_to_load = [].
1178		-
1179		-public define Printable_tree
1180		- format
1181		- (
1182		- Web_body_option o
1183		- ) =
1184		- if o is
1185		- {
1186		- background_color(c) then [" bgcolor=" , (String)format(c)],
1187		- psychedelic_background(a,f,d) then add_script(psychedelic_bg(a,f,d)); [ ],
1188		- background_image(n) then [" background=", n],
1189		- scrolling_layer(disp,st,m,t,c,p) then add_script(s_layer(disp,st,m,t,c,p,2000\p)); [ ],
1190		- bounce(i,l,r,t,b) then add_script(bnce(i,l,r,t,b)); [ ],
1191		- over(i,l,t) then add_script(over(i,l,t)); [ ],
1192		- follow_path(li,ns,p,l,s,d) then add_script(follow_path(li,ns,p,l,s,d)); [ ],
1193		- load_image(n) then images_to_load <- [simple(n) . *images_to_load]; [ ],
1194		- left_margin(n) then [" leftmargin=", n],
1195		- top_margin(n) then [" topmargin=", n],
1196		- margin_width(n) then [" marginwidth=", n],
1197		- margin_height(n) then [" marginheight=", n],
1198		- reload_frame(n,url) then add_body_onload(reload_frame(n,url)); [ ],
1199		- onload(n) then [" onLoad=\"", n, "()\""]
1200		- }.
1201		-
1202		-define Printable_tree
1203		- preload_list
1204		- (
1205		- List(ImageToLoad) images,
1206		- Int n,
1207		- ) =
1208		- if images is
1209		- {
1210		- [ ] then [ ],
1211		- [h . t] then
1212		- [" preloaded_images[",n,"].src = '",image_name(h),"';",
1213		- if h is
1214		- {
1215		- simple(_) then [],
1216		- with_rollover(n1,r) then
1217		- [" preloaded_images[",n1,"].onload = 'allow_rollover(\"",r,"\")';"]
1218		- }
1219		- . preload_list(t,n-1)]
1220		- }.
1221		-
1222		-define Printable_tree
1223		- load_image_script
1224		- (
1225		- List(ImageToLoad) images
1226		- ) =
1227		- if images is
1228		- {
1229		- [ ] then [ ],
1230		- [_ . _] then
1231		- [
1232		- "<script>",
1233		- " var preloaded_images = new Array(",length(images),");",
1234		- " var pi_i = 0;",
1235		- " for(pi_i = 0; pi_i < ",length(images),"; pi_i++) {",
1236		- " preloaded_images[pi_i] = new Image(); }",
1237		- " function preload_images() {",
1238		- preload_list(images,length(images)-1),
1239		- " }</script>"
1240		- ]
1241		- }.
1242		-
1243		-
1244		-public define Printable_tree format(String c_ticket,
1245		- String s_ticket,
1246		- Web_item i).
1247		-
1248		-
1249		-public define Printable_tree
1250		- format(List(Table_option) l) =
1251		- if l is
1252		- {
1253		- [ ] then [ ],
1254		- [h . t] then [if h is
1255		- {
1256		- background_color(c) then [" bgcolor=", (String)format(c)],
1257		- background_image(f) then [" background=",f],
1258		- border then [" border"],
1259		- nude then [" border=\"0\" cellspacing=\"0\" cellpadding=\"0\""],
1260		- border(e,top,i) then [" border=",e," cellspacing=",top," cellpadding=",i],
1261		- border_color(c) then [" bordercolor=", (String)format(c)],
1262		- absolute_width(n) then [" width=",n]
1263		- }, format(t)]
1264		- }.
1265		-
1266		-
1267		-
1268		-public define Printable_tree
1269		- format(List(Row_option) l) =
1270		- if l is
1271		- {
1272		- [ ] then [ ],
1273		- [first . others] then [if first is
1274		- {
1275		- left then [" align=left"],
1276		- h_center then [" align=center"],
1277		- right then [" align=right"],
1278		- top then [" valign=top"],
1279		- v_center then [" valign=center"],
1280		- bottom then [" valign=bottom"],
1281		- absolute_height(n) then [" height=\"",n,"\""],
1282		- base_line then [" valign=baseline"],
1283		- background_color(c) then [" bgcolor=",(String)format(c)]
1284		- },
1285		- format(others)]
1286		- }.
1287		-
1288		-
1289		-
1290		-
1291		-public define Int
1292		- percentage(Int n) =
1293		- if n < 0 then 0
1294		- else if n > 100 then 100
1295		- else n.
1296		-
1297		- public define Int percentage(Int n) = n.
1298		-
1299		-
1300		-
1301		-
1302		-public define Printable_tree
1303		- format
1304		- (
1305		- List(Web_body_option) l
1306		- ) =
1307		- if l is
1308		- {
1309		- [ ] then [ ],
1310		- [h . t] then [format(h) . format(t)]
1311		- }.
1312		-
1313		-
1314		-
1315		-
1316		-public define Printable_tree
1317		- format(List(Cell_option) l) =
1318		- if l is
1319		- {
1320		- [ ] then [ ],
1321		- [first . others] then
1322		- [if first is
1323		- {
1324		- left then (Printable_tree)[" align=left"],
1325		- h_center then (Printable_tree)[" align=center"],
1326		- right then (Printable_tree)[" align=right"],
1327		- top then (Printable_tree)[" valign=top"],
1328		- v_center then (Printable_tree)[" valign=center"],
1329		- bottom then (Printable_tree)[" valign=bottom"],
1330		- base_line then (Printable_tree)[" valign=baseline"],
1331		- background_color(c) then (Printable_tree)[" bgcolor=",(String)format(c)],
1332		- background_image(n) then (Printable_tree)[" style=\"background: url(",n,")\""],
1333		- absolute_width(w) then (Printable_tree)[" width=",w],
1334		- relative_width(r) then (Printable_tree)[" width=",percentage(r),""],
1335		- absolute_height(h) then (Printable_tree)[" height=",h],
1336		- relative_height(r) then (Printable_tree)[" height=",percentage(r),""],
1337		- columns(n) then (Printable_tree)[" colspan=",n],
1338		- rows(n) then (Printable_tree)[" rowspan=",n],
1339		- nowrap then (Printable_tree)[" nowrap"]
1340		- }
1341		- . format(others)]
1342		- }.
1343		-
1344		-
1345		-
1346		-public define Printable_tree
1347		- format
1348		- (
1349		- String c_ticket,
1350		- String s_ticket,
1351		- List(Cell) l
1352		- ) =
1353		- if l is
1354		- {
1355		- [ ] then [ ],
1356		- [first . others] then
1357		- [if first is cell(options,item) then
1358		- ["<td",format(options),">",
1359		- format(c_ticket,s_ticket,item),"</td>"],
1360		- format(c_ticket,s_ticket,others)]
1361		- }.
1362		-
1363		-
1364		-public define Printable_tree
1365		- format
1366		- (
1367		- String c_ticket,
1368		- String s_ticket,
1369		- List(Table_row) l
1370		- ) =
1371		- if l is
1372		- {
1373		- [ ] then [ ],
1374		- [first_row . other_rows]
1375		- then [if first_row is
1376		- {
1377		- row(options,cells) then
1378		- [ "<tr",format(options),">",
1379		- format(c_ticket,s_ticket,cells),"</tr>"]
1380		- },
1381		- format(c_ticket,s_ticket,other_rows)]
1382		- }.
1383		-
1384		-
1385		-public define Printable_tree
1386		- format_choices
1387		- (
1388		- List(String) l
1389		- ) =
1390		- if l is
1391		- {
1392		- [ ] then [ ],
1393		- [h . t] then ["<option>",h . format_choices(t)]
1394		- }.
1395		-
1396		-
1397		-public define Printable_tree
1398		- format_choices
1399		- (
1400		- List(String) l,
1401		- String selected
1402		- ) =
1403		- if l is
1404		- {
1405		- [ ] then [ ],
1406		- [h . t] then if h = selected
1407		- then ["<option selected>",h . format_choices(t)]
1408		- else ["<option>",h . format_choices(t,selected)]
1409		- }.
1410		-
1411		-
1412		-public define Printable_tree
1413		- format_list
1414		- (
1415		- String c_ticket,
1416		- String s_ticket,
1417		- List(Web_item) l
1418		- ) =
1419		- if l is
1420		- {
1421		- [ ] then [ ],
1422		- [h . t] then ["<li>",format(c_ticket,s_ticket,h),
1423		- format_list(c_ticket,s_ticket,t)]
1424		- }.
1425		-
1426		-
1427		-public define String
1428		- format
1429		- (
1430		- WebStyle ws
1431		- ) =
1432		- if ws is
1433		- {
1434		- background_image(fn) then "background: url("+fn+")",
1435		- background_color(c) then "background: "+format(c),
1436		- background_transparent then "background: transparent",
1437		- background_repeat_horizontal then "background: repeat-x",
1438		- background_repeat_vertical then "background: repeat-y",
1439		- background_no_repeat then "background: no-repeat",
1440		- color(wc) then if wc is
1441		- {
1442		- rgb(r,g,b) then "color: rgb("+r+","+g+","+b+")",
1443		- _(c) then "color: "+format(c)
1444		- },
1445		- float_to_left then "float: left",
1446		- float_to_right then "float: right",
1447		- font_family(n) then "font-family: "+n,
1448		- font_size(n) then "font-size: "+to_decimal(n)+"pt",
1449		- italic then "font-style: italic",
1450		- oblique then "font-style: oblique",
1451		- small_capitals then "font-variant: small-caps",
1452		- bold then "font-weight: bold",
1453		- bolder then "font-weight: bolder",
1454		- lighter then "font-weight: lighter",
1455		- line_height(h) then "line-height: "+to_decimal(h),
1456		- text_center then "text-align: center",
1457		- text_left then "text-align: left",
1458		- text_right then "text-align: right",
1459		- text_justify then "text-align: justify",
1460		- text_underline then "text-decoration: underline",
1461		- text_blink then "text-decoration: blink",
1462		- text_line_through then "text-decoration: line-through",
1463		- width(n) then "width: "+to_decimal(n),
1464		- }.
1465		-
1466		-
1467		-public define Printable_tree
1468		- format
1469		- (
1470		- List(WebStyle) l
1471		- ) =
1472		- if l is
1473		- {
1474		- [ ] then [ ],
1475		- [h . t] then
1476		- if t is
1477		- {
1478		- [ ] then [format(h)],
1479		- [_ . _] then [format(h), "; " . format(t)]
1480		- }
1481		- }.
1482		-
1483		-
1484		-define Printable_tree
1485		- format_polygon_coordinates
1486		- (
1487		- List((Int,Int)) vertices
1488		- ) =
1489		- if vertices is
1490		- {
1491		- [ ] then [ ],
1492		- [h . t] then
1493		- if h is (x,y) then
1494		- if t is []
1495		- then [ x,",",y ]
1496		- else [ x,",",y,"," . format_polygon_coordinates(t)]
1497		- }.
1498		-
1499		- define Printable_tree
1500		- format
1501		- (
1502		- List(Mouse_Sensitive_Zone) zones
1503		- ) =
1504		- if zones is
1505		- {
1506		- [ ] then [ ],
1507		- [h . t] then
1508		- [
1509		- if h is
1510		- {
1511		- rectangle(lt,rb,url) then
1512		- if lt is (left,top) then
1513		- if rb is (right,bottom) then
1514		- [ "<area shape=rect coords=\"",left,",",top,",",right,",",bottom,
1515		- "\" href=\"",url,"\">" ],
1516		- circle(c,r,url) then
1517		- if c is (x,y) then
1518		- [ "<area shape=circle coords=\"",x,",",y,",",r,
1519		- "\" href=\"",url,"\">" ],
1520		- polygon(vs,url) then
1521		- [ "<area shape=poly coords=\"",format_polygon_coordinates(vs),
1522		- "\" href=\"",url,"\">" ]
1523		- }
1524		- . format(t)]
1525		- }.
1526		-
1527		-define Printable_tree
1528		- format
1529		- (
1530		- List(Mouse_Sensitive_Zone) zones,
1531		- String c_ticket,
1532		- String s_ticket,
1533		- ) =
1534		- if zones is
1535		- {
1536		- [ ] then [ ],
1537		- [h . t] then
1538		- [
1539		- if h is
1540		- {
1541		- rectangle(lt,rb,url) then
1542		- if lt is (left,top) then
1543		- if rb is (right,bottom) then
1544		- [ "<area shape=rect coords=\"",left,",",top,",",right,",",bottom,
1545		- "\" href=\"", url + "&c_ticket=" + c_ticket + "&s_ticket=" + s_ticket,"\">" ],
1546		- circle(c,r,url) then
1547		- if c is (x,y) then
1548		- [ "<area shape=circle coords=\"",x,",",y,",",r,
1549		- "\" href=\"", url + "&c_ticket=" + c_ticket + "&s_ticket=" + s_ticket,"\">" ],
1550		- polygon(vs,url) then
1551		- [ "<area shape=poly coords=\"",format_polygon_coordinates(vs),
1552		- "\" href=\"", url + "&c_ticket=" + c_ticket + "&s_ticket=" + s_ticket,"\">" ]
1553		- }
1554		- . format(t, c_ticket, s_ticket)]
1555		- }.
1556		-
1557		-variable Int map_number = 0.
1558		-
1559		-define Printable_tree
1560		- format_mouse_sensitive_image
1561		- (
1562		- String image_file_name,
1563		- List(Mouse_Sensitive_Zone) zones,
1564		- String c_ticket,
1565		- String s_ticket,
1566		- ) =
1567		- map_number <- (*map_number)+1;
1568		- [
1569		- "<img src=\"",image_file_name,"\" usemap=\"#imsensmap",*map_number,"\" border=0>",
1570		- "<map name=\"imsensmap",*map_number,"\">",
1571		- format(zones, c_ticket, s_ticket),
1572		- "</map>"
1573		- ].
1574		-
1575		-
1576		- Find an 'upload' in a web item.
1577		-
1578		-define Bool
1579		- find_upload
1580		- (
1581		- Web_item i
1582		- ).
1583		-
1584		-define Bool
1585		- find_upload
1586		- (
1587		- List(Web_item) li
1588		- ) =
1589		- if li is
1590		- {
1591		- [ ] then false,
1592		- [h . t] then if find_upload(h) then true else find_upload(t)
1593		- }.
1594		-
1595		-define Bool
1596		- find_upload
1597		- (
1598		- Cell c
1599		- ) =
1600		- if c is cell(lo,wi) then find_upload(wi).
1601		-
1602		-define Bool
1603		- find_upload
1604		- (
1605		- List(Cell) lc
1606		- ) =
1607		- if lc is
1608		- {
1609		- [ ] then false,
1610		- [h . t] then if find_upload(h) then true else find_upload(t)
1611		- }.
1612		-
1613		-
1614		-
1615		-define Bool
1616		- find_upload
1617		- (
1618		- Table_row tr
1619		- ) =
1620		- if tr is
1621		- {
1622		- row(lo,lc) then find_upload(lc)
1623		- }.
1624		-
1625		-define Bool
1626		- find_upload
1627		- (
1628		- List(Table_row) l
1629		- ) =
1630		- if l is
1631		- {
1632		- [ ] then false,
1633		- [h . t] then
1634		- if find_upload(h) then true else find_upload(t)
1635		- }.
1636		-
1637		-define Bool
1638		- find_upload
1639		- (
1640		- Web_item wi
1641		- ) =
1642		- if wi is
1643		- {
1644		- [ ] then (Bool)false,
1645		- [a . b] then (Bool)if find_upload(a) then true else find_upload(b),
1646		- text(_) then (Bool)false,
1647		- text_pt(_) then (Bool)false,
1648		- text_nowrap(_) then (Bool)false,
1649		- text_nowrap_pt(_) then (Bool)false,
1650		- par(_) then (Bool)false,
1651		- preformated_text(_) then (Bool)false,
1652		- integer(_) then (Bool)false,
1653		- float(_,_) then (Bool)false,
1654		- center(i) then (Bool)find_upload(i),
1655		- bigger(n,i) then (Bool)find_upload(i),
1656		- smaller(n,i) then (Bool)find_upload(i),
1657		- bold(i) then (Bool)find_upload(i),
1658		- italic(i) then (Bool)find_upload(i),
1659		- big(i) then (Bool)find_upload(i),
1660		- very_big(i) then (Bool)find_upload(i),
1661		- style(_,i) then (Bool)find_upload(i),
1662		- spacer(_,_) then (Bool)false,
1663		- image(_) then (Bool)false,
1664		- image_d(_,_) then (Bool)false,
1665		- image_pt(_) then (Bool)false,
1666		- on_image(_,_) then (Bool)false,
1667		- turning_images(_,_) then (Bool)false,
1668		- rollover(_,_,_,_,_,_) then (Bool)false,
1669		- rollover(_,_,_,_,_,_,_,_) then (Bool)false,
1670		- mouse_sensitive_image(_,_) then (Bool)false,
1671		- background_sound(_,_) then (Bool)false,
1672		- form(_,c) then (Bool)find_upload(c),
1673		- form_target(_,c,_) then (Bool)find_upload(c),
1674		- form(_,_,c) then (Bool)find_upload(c),
1675		- form_name(_,c) then (Bool)find_upload(c),
1676		- text_input(_,_,_) then (Bool)false,
1677		- password_input(_,_) then (Bool)false,
1678		- text_area(_,_,_,_) then (Bool)false,
1679		- upload(_,_) then (Bool)true,
1680		- submit(_) then (Bool)false,
1681		- submit_pt(_) then (Bool)false,
1682		- submit(_,_) then (Bool)false,
1683		- submit_close(_,_) then (Bool)false,
1684		- submit_pt2(_,_) then (Bool)false,
1685		- image_submit(_,_) then (Bool)false,
1686		- image_submit(_,_,_,_) then (Bool)false,
1687		- hl_image_submit(_,_,_,_,_) then (Bool)false,
1688		- text_submit(_,_,_) then (Bool)false,
1689		- web_submit(_,c) then (Bool)find_upload(c),
1690		- button(_,_,_,_,_) then (Bool)false,
1691		- mark(_,_) then (Bool)false,
1692		- mark_pt(_,_) then (Bool)false,
1693		- close_button then (Bool)false,
1694		- close_button(_) then (Bool)false,
1695		- label(_) then (Bool)false,
1696		- go_to_label(_,i) then (Bool)find_upload(i),
1697		- table(_,rows) then (Bool)find_upload(rows),
1698		- list(l) then (Bool)find_upload(l),
1699		- link(_,i) then (Bool)find_upload(i),
1700		- link(_,_,i) then (Bool)find_upload(i),
1701		- link_for_download(n,i) then (Bool)find_upload(i),
1702		- mail_to(_,i) then (Bool)find_upload(i),
1703		- select(_,_,_) then (Bool)false,
1704		- select(_,_,_,_) then (Bool)false,
1705		- immediate_select(_,_,_) then (Bool)false,
1706		- radio_button(_,_) then (Bool)false,
1707		- checked_radio_button(_,_) then (Bool)false,
1708		- check_box(_,_) then (Bool)false,
1709		- checked_box(_,_) then (Bool)false,
1710		- link_to_window(_,i) then (Bool)find_upload(i),
1711		- link_to_window(_,_,i) then (Bool)find_upload(i),
1712		- link_to_window_with_ticket(_,_,_,i,_,_) then (Bool)find_upload(i),
1713		- link_to_window_with_ticket_and_scroll(_,_,_,i,_,_) then (Bool)find_upload(i),
1714		- link_to_window_with_ticket_and_scroll(_,_,_,_,i,_,_) then (Bool)find_upload(i),
1715		- link_to_frame(_,_,i) then (Bool)find_upload(i),
1716		- }.
1717		-
1718		-
1719		- The next function generates "enctype=multipart/form-data" or "", depending on the presence of
1720		- an 'upload' in form-content.
1721		-
1722		-define String
1723		- enctype
1724		- (
1725		- Web_item form_content
1726		- ) =
1727		- if find_upload(form_content)
1728		- then "enctype=multipart/form-data"
1729		- else "".
1730		-
1731		-define Printable_tree
1732		- set_turning_images_sources
1733		- (
1734		- Int i,
1735		- String name,
1736		- List(String) filenames
1737		- ) =
1738		- if filenames is
1739		- {
1740		- [ ] then [ ],
1741		- [h . t] then
1742		- [" i",name,"[",i,"].src=\"",h,"\";"
1743		- . set_turning_images_sources(i+1,name,t)]
1744		- }.
1745		-
1746		-define Bool
1747		- member
1748		- (
1749		- Word8 x,
1750		- Printable_tree t
1751		- ) =
1752		- if t is
1753		- {
1754		- [] then false,
1755		- str_pt(String _0,Printable_tree _1) then (member(x,_0) \| member(x,_1)),
1756		- ba_pt(ByteArray _0,Printable_tree _1) then (member(x,to_string(_0)) \| member(x,_1)),
1757		- int_pt(Int _0,Printable_tree _1) then (member(x,to_decimal(_0)) \| member(x,_1)),
1758		- pt_pt(Printable_tree _0,Printable_tree _1) then (member(x,_0) \| member(x,_1))
1759		- }.
1760		-
1761		-public define Printable_tree
1762		- format
1763		- (
1764		- String c_ticket,
1765		- String s_ticket,
1766		- Web_item wi
1767		- ) =
1768		- if wi is
1769		- {
1770		- [ ] then (Printable_tree)[ ],
1771		-
1772		- [a . b] then (Printable_tree)[format(c_ticket,s_ticket,a), " ",
1773		- format(c_ticket,s_ticket,b)],
1774		-
1775		- text(String s) then (Printable_tree)[s],
1776		-
1777		- text_pt(Printable_tree s) then (Printable_tree)s,
1778		-
1779		- text_nowrap(String s) then (Printable_tree)["<table><tr><td nowrap=\"nowrap>",s,"</td></tr></table>"],
1780		-
1781		- text_nowrap_pt(Printable_tree s) then
1782		- (Printable_tree)["<table><tr><td \"nowrap\">",s,"</td></tr></table>"],
1783		-
1784		- par(s) then (Printable_tree)
1785		- [ "<p align=\"justify\">", s, " </p>"],
1786		-
1787		- preformated_text(t) then (Printable_tree) ["<pre>",t,"</pre>"],
1788		-
1789		- integer(n) then (Printable_tree)[n],
1790		-
1791		- float(f,p) then (Printable_tree)[float_to_string(f,p)],
1792		-
1793		- center(item) then (Printable_tree)["<center>", format(c_ticket,s_ticket,item),"</center>"],
1794		-
1795		- bigger(n,item) then (Printable_tree)["<font size=\"+",n,"\">",format(c_ticket,s_ticket,item),"</font>"],
1796		-
1797		- smaller(n,item) then (Printable_tree)["<font size=\"-",n,"\">",format(c_ticket,s_ticket,item),"</font>"],
1798		-
1799		- bold(item) then
1800		- (Printable_tree)["<font style=\"font-weight: bold\">",format(c_ticket,s_ticket,item),"</font>"],
1801		-
1802		- italic(item) then
1803		- (Printable_tree)["<font style=\"font-style: italic\">",format(c_ticket,s_ticket,item),"</font>"],
1804		-
1805		- big(item) then (Printable_tree)["<font size=\"+1\">",format(c_ticket,s_ticket,item),"</font>"],
1806		-
1807		- very_big(item) then (Printable_tree)["<h1>",format(c_ticket,s_ticket,item),"</h1>"],
1808		-
1809		- style(l,i) then
1810		- (Printable_tree)["<span style=\"", format(l), "\">", format(c_ticket,s_ticket,i), "</span>"],
1811		-
1812		- spacer(w,h) then (Printable_tree)
1813		- ["<img src=\"spacer.gif\" width=\"",w,"\" height=\"",h,"\" border=\"0\">"],
1814		-
1815		- image(String f) then (Printable_tree)["<img src=\"", f,"\" border=\"0\">"],
1816		-
1817		- image_d(fn,desc) then (Printable_tree)["<img src=\"", fn,"\" alt=\"",desc,"\" border=\"0\">"],
1818		-
1819		- image_pt(Printable_tree l) then (Printable_tree)["<img src=\"", l,"\" border=\"0\">"],
1820		-
1821		- on_image(fn,x) then (Printable_tree)
1822		- ["<span style=\"background: url(",fn,")\">",format(c_ticket,s_ticket,x),"</span>"],
1823		-
1824		- turning_images(fns,msec) then if fns is [im0 . imo] then
1825		- with name = "trni"+to_decimal(new_web_count), n = 1+length(imo), (Printable_tree)
1826		- ["<script>",
1827		- "var i",name,"=new Array(",n,");",
1828		- "var n",name,"=0;",
1829		- "for(var i=0; i<",n,"; i++) {",
1830		- " i",name,"[i]=new Image(); }",
1831		- set_turning_images_sources(0,name,(List(String))[im0 . imo]),
1832		-
1833		- "function a",name,"() {",
1834		- "if (i",name,"[(n",name,"+1)%",n,"].complete)",
1835		- "{n",name,"=(n",name,"+1)%",n,";",
1836		- "document.",name,".src=i",name,"[n",name,"].src; }",
1837		- "setTimeout(\"a",name,"()\",",msec,"); }",
1838		-
1839		- "setTimeout(\"a",name,"()\",",msec,");",
1840		- "</script>",
1841		- "<img src=\"",im0,"\" name=\"",name,"\" border=\"0\">"],
1842		-
1843		- rollover(prlim,url,target,ion,ioff,descr) then (Printable_tree)
1844		- (images_to_load <- [simple(ion) . *images_to_load];
1845		- with name = "ron_"+to_decimal(new_web_count),
1846		- ["<a target=\"",target,"\" href=\"",url,
1847		- (if (c_ticket = "" & s_ticket = "") then "" else (if member('?',url) then "&" else "?")),
1848		- (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]),
1849		- (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
1850		- "\" onmouseout=\"",name,".src='",ioff,
1851		- "';\" onmouseover=\"",name,".src='",ion,"';\"><img src=\"",ioff,
1852		- "\" name=\"",name,"\" alt=\"",descr,"\" border=\"0\"></a>"]),
1853		-
1854		- rollover(prlim,url,target,ion,ioff,w,h,descr) then (Printable_tree)
1855		- (images_to_load <- [simple(ion) . *images_to_load];
1856		- with name = "ron_"+to_decimal(new_web_count),
1857		- ["<a target=\"",target,"\" href=\"",url,
1858		- (if (c_ticket = "" & s_ticket = "") then "" else (if member('?',url) then "&" else "?")),
1859		- (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]),
1860		- (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
1861		- "\" onmouseout=\"",name,".src='",ioff,
1862		- "';\" onmouseover=\"",name,".src='",ion,"';\"><img src=\"",ioff,
1863		- "\" name=\"",name,"\" width=\"",w,"\" height=\"",h,"\" alt=\"",descr,"\" border=\"0\"></a>"]),
1864		-
1865		- mouse_sensitive_image(fn,lz) then (Printable_tree)
1866		- format_mouse_sensitive_image(fn,lz, c_ticket, s_ticket),
1867		-
1868		- background_sound(sfn,loop) then (Printable_tree)
1869		- ["<embed src=\"", sfn, "\" autostart=\"true\" loop=\"", if loop then "true\">" else "false\">"],
1870		-
1871		- form(n,c) then (Printable_tree)
1872		- ["<form ",enctype(c)," method=\"post\" action=\"", n, "\">",
1873		- "<input type=\"hidden\" name=\"s_ticket\" value=\"",s_ticket,"\" />",
1874		- "<input type=\"hidden\" name=\"c_ticket\" value=\"",c_ticket,"\" />",
1875		- format(c_ticket,s_ticket,c),"</form>"],
1876		-
1877		- form_target(n,c,t) then (Printable_tree)
1878		- ["<form ",enctype(c)," method=\"post\" action=\"", n, "\" target=\"", t, "\">",
1879		- "<input type=\"hidden\" name=\"s_ticket\" value=\"",s_ticket,"\" />",
1880		- "<input type=\"hidden\" name=\"c_ticket\" value=\"",c_ticket,"\" />",
1881		- format(c_ticket,s_ticket,c),"</form>"],
1882		-
1883		- form(n,l,c) then (Printable_tree)
1884		- ["<form ",enctype(c)," method=\"post\" action=\"", n,"#", l, "\">",
1885		- "<input type=\"hidden\" name=\"s_ticket\" value=\"",s_ticket,"\" />",
1886		- "<input type=\"hidden\" name=\"c_ticket\" value=\"",c_ticket,"\" />",
1887		- format(c_ticket,s_ticket,c),"</form>"],
1888		-
1889		- form_name(fn,c) then (Printable_tree)
1890		- [
1891		- // "<form ",enctype(c), "\" name=\"", fn, "\">",
1892		- "<form name=\"", fn, "\">",
1893		- "<input type=\"hidden\" name=\"s_ticket\" value=\"",s_ticket,"\" />",
1894		- "<input type=\"hidden\" name=\"c_ticket\" value=\"",c_ticket,"\" />",
1895		- format(c_ticket,s_ticket,c),"</form>"],
1896		-
1897		- text_input(n,s,v) then (Printable_tree)
1898		- ["  <input type=\"text\" name=\"", n, "\" size=\"", s, "\" value=\"", v,"\" />"],
1899		-
1900		- password_input(n,s) then (Printable_tree)
1901		- ["  <input type=\"password\" name=\"", n, "\" size=\"", s,"\" />"],
1902		-
1903		- text_area(name,c,r,i) then (Printable_tree)
1904		- ["<textarea name=\"",name,"\" cols=\"",c,"\" rows=\"",r,"\" wrap=\"physical\">",i,"</textarea>"],
1905		-
1906		- upload(n,size) then (Printable_tree)
1907		- ["<input type=\"file\" size=\"",size,"\" multiple=\"multiple\" name=\"",n,"\" />"],
1908		-
1909		- submit(String t) then (Printable_tree)["<input type=\"submit\" value=\"",t,"\" />"],
1910		-
1911		- submit_pt(Printable_tree t) then (Printable_tree)["<input type=\"submit\" value=\"",t,"\" />"],
1912		-
1913		- submit(n, String t) then (Printable_tree)
1914		- ["<input type=\"submit\" name=\"",n,"\" value=\"",t,"\">"],
1915		-
1916		- submit_close(n, String t) then (Printable_tree)
1917		- ["<input type=\"submit\" name=\"",n,"\" value=\"",t,"\" onclick=\"window.top.close();\" />"],
1918		-
1919		- submit_pt2(n, Printable_tree t) then (Printable_tree)
1920		- ["<input type=\"submit\" name=\"",n,"\" value=\"",t,"\" />"],
1921		-
1922		- image_submit(n,ifn) then (Printable_tree)
1923		- ["<input type=\"image\" name=\"",n,"\" src=\"",ifn,"\" border=\"0\" />"],
1924		-
1925		- image_submit(n,v,ifn,c) then (Printable_tree)
1926		- ["<img src=\"",ifn,"\" onmousedown=\"document.forms[0].action='",
1927		- n,"=",v,"'; document.forms[0].submit();\" />"],
1928		-
1929		- hl_image_submit(n,v,in,ifn,hlifn) then (Printable_tree)
1930		- ["<img src=\"",ifn,"\"",
1931		- //" name=\"",in,"\"",
1932		- " onmouseover=\"this.src='",hlifn,"'\"",
1933		- " onmouseout=\"this.src='",ifn,"'\"",
1934		- " onmousedown=\"document.forms[0].action='",
1935		- n,"=",v,"'; document.forms[0].submit();\" />"],
1936		-
1937		- text_submit(n,v,t) then (Printable_tree)
1938		- ["<a href=\"",n,
1939		- (if (s_ticket = "" & c_ticket = "" & v = "") then "" else "?"),
1940		- (if s_ticket = "" then [ ] else ["s_ticket=",s_ticket,"&"]),
1941		- (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]),
1942		- v,"\">",t,"</a>"],
1943		-
1944		-
1945		- web_submit(wa,i) then (Printable_tree)
1946		- ["<a href=\"javascript:document.forms[0].action='",
1947		- wa,"'; document.forms[0].submit();\">",format(c_ticket,s_ticket,i),"</a>"],
1948		-
1949		- button(n, String t, String o, Int w, Int h) then (Printable_tree)
1950		- ["<input type=button name=",n," value=\"",t,
1951		- "\"style=\"width=",w, ";height=", h, "\" ", "\" onclick=\"", o, "\";\" />"],
1952		-
1953		- mark(n, String v) then (Printable_tree)
1954		- ["<input type=\"hidden\" name=\"",n,"\" value=\"",v,"\" />"],
1955		-
1956		- mark_pt(n, Printable_tree v) then (Printable_tree)
1957		- ["<input type=\"hidden\" name=\"",n,"\" value=\"",v,"\" />"],
1958		-
1959		- close_button then (Printable_tree)
1960		- ["<form><input type=\"button\" value=\" Fermer \" onclick=\"window.top.close();\"></form>"],
1961		-
1962		- close_button(ifn) then (Printable_tree)
1963		- ["<form><input type=\"image\" name=\"close\" src=\"", ifn,
1964		- "\" onclick=\"window.top.close();\" /></form>"],
1965		-
1966		-/*
1967		- close_button(ifn) then (Printable_tree)
1968		- ["<form><input type=\"button\" name=\"close\" src=\"", ifn,
1969		- "\" onclick=\"window.top.close();\"></form>"],
1970		-*/
1971		- label(name) then (Printable_tree)["<a name=\"",name,"\" />"],
1972		-
1973		- go_to_label(name,content) then (Printable_tree)["<a href=#",name,">",
1974		- format(c_ticket,s_ticket,content),"</a>"],
1975		-
1976		- table(ops,rows) then (Printable_tree)["<table ",
1977		- format(ops), ">",format(c_ticket,s_ticket,rows),"</table>"],
1978		-
1979		- list(l) then (Printable_tree)["<ul>",format_list(c_ticket,s_ticket,l),"</ul>"],
1980		-
1981		- link(name,i) then (Printable_tree)["<a href=\"",name,
1982		- (if (c_ticket = "" & s_ticket = "") then "" else (if member('?',name) then "&" else "?")),
1983		- (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]),
1984		- (if s_ticket = "" then [ ] else [if c_ticket = "" then "" else "&","s_ticket=",s_ticket]),
1985		- "\">",format(c_ticket,s_ticket,i),"</a>"],
1986		-
1987		- link(name,target,i) then (Printable_tree)["<a target=\"",target,"\" href=\"",name,
1988		- (if (c_ticket = "" & s_ticket = "") then "" else (if member('?',name) then "&" else "?")),
1989		- (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]),
1990		- (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
1991		- "\">",format(c_ticket,s_ticket,i),"</a>"],
1992		-
1993		- link_for_download(fname,i) then (Printable_tree)
1994		- ["<a href=\"",fname,"?download\">",format(c_ticket,s_ticket,i),"</a>"],
1995		-
1996		- mail_to(addr,i) then (Printable_tree)["<a href=\"mailto:",addr,"\">",
1997		- format(c_ticket,s_ticket,i),"</a>"],
1998		-
1999		- select(name,size,choices) then (Printable_tree)
2000		- ["<select name=\"",name,"\" size=\"",size,"\">",format_choices(choices),"</select>" ],
2001		-
2002		- select(name,size,choices,selected) then (Printable_tree)
2003		- ["<select name=\"",name,"\" size=\"",size,"\">",format_choices(choices,selected),"</select>" ],
2004		-
2005		- immediate_select(name,size,choices) then (Printable_tree)
2006		- ["<select name=\"",name,"\" size=\"",size,"\" onchange=\"submit();\">",
2007		- format_choices(choices),"</select>" ],
2008		-
2009		- radio_button(n,v) then (Printable_tree)
2010		- ["<input type=\"radio\" name=\"", n, "\" value=\"", v, "\" />"],
2011		-
2012		- checked_radio_button(n,v) then (Printable_tree)
2013		- ["<input type=\"radio\" checked=\"checked\" name=\"", n, "\" value=\"", v, "\" />"],
2014		-
2015		- check_box(n,v) then (Printable_tree)
2016		- ["<input type=\"checkbox\" name=\"", n, "\" value=\"", v, "\" />"],
2017		-
2018		- checked_box(n,v) then (Printable_tree)
2019		- ["<input type=\"checkbox\" checked=\"checked\" name=\"", n, "\" value=\"", v, "\" />"],
2020		-
2021		- link_to_window(n,i) then (Printable_tree)
2022		- ["<a href=\"javascript:void window.open('",n,"','default','resizable,scrollbars');\">",
2023		- format(c_ticket,s_ticket,i),"</a>"],
2024		-
2025		- link_to_window(n,wn,i) then (Printable_tree)
2026		- ["<a href=\"javascript:void window.open('",n,"','",wn,"','resizable,scrollbars');\" />",
2027		- format(c_ticket,s_ticket,i),"</a>"],
2028		-
2029		- link_to_window_with_ticket(n,args,wn,i,w,h) then (Printable_tree)
2030		- ["<a href=\"javascript:void window.open('",n,"?c_ticket=",c_ticket,
2031		- (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
2032		- "&target=",wn,
2033		- if args="" then "" else "&",
2034		- args,"','",
2035		- wn,"','width=",w,",height=",h,"');\">",
2036		- format(c_ticket,s_ticket,i),"</a>"],
2037		-
2038		- link_to_window_with_ticket_and_scroll(n,args,wn,i,w,h) then (Printable_tree)
2039		- ["<a href=\"javascript:void window.open('",n,"?c_ticket=",c_ticket,
2040		- (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
2041		- "&target=",wn,
2042		- if args="" then "" else "&",
2043		- args,"','",
2044		- wn,"','width=",w,",height=",h,", resizable,scrollbars');\">",
2045		- format(c_ticket,s_ticket,i),"</a>"],
2046		-
2047		- link_to_window_with_ticket_and_scroll(n,lab,args,wn,i,w,h) then (Printable_tree)
2048		- ["<a href=\"javascript:void window.open('",n,"?c_ticket=",c_ticket,
2049		- (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
2050		- "&target=",wn,
2051		- if args="" then "" else "&",
2052		- args,"&#",lab, "','",
2053		- wn,"','width=",w,",height=",h,", resizable,scrollbars');\">",
2054		- format(c_ticket,s_ticket,i),"</a>"],
2055		-
2056		- link_to_frame(n,fn,i) then ["<a href=\"",n,
2057		- (if member('?',n) then "&" else "?"),
2058		- (if c_ticket = "" then [ ] else ["c_ticket=",c_ticket]),
2059		- (if s_ticket = "" then [ ] else ["&s_ticket=",s_ticket]),
2060		- "\" target=\"",fn,"\">",
2061		- format(c_ticket,s_ticket,i),"</a>"]
2062		-
2063		- }.
2064		-
2065		-
2066		-
2067		-define Printable_tree
2068		- add_tickets
2069		- (
2070		- String c_ticket,
2071		- String s_ticket,
2072		- String url
2073		- ) =
2074		- if member('?',url)
2075		- then [url , "&c_ticket=", c_ticket, "&s_ticket=", s_ticket ]
2076		- else [url , "?c_ticket=", c_ticket, "&s_ticket=", s_ticket ].
2077		-
2078		-define Printable_tree
2079		- add_tickets
2080		- (
2081		- String c_ticket,
2082		- String s_ticket,
2083		- Printable_tree url
2084		- ) =
2085		- if member('?',url)
2086		- then [url , "&c_ticket=", c_ticket, "&s_ticket=", s_ticket ]
2087		- else [url , "?c_ticket=", c_ticket, "&s_ticket=", s_ticket ].
2088		-
2089		-
2090		-define Printable_tree
2091		- format
2092		- (
2093		- List(VFrame) frames,
2094		- String c_ticket,
2095		- String s_ticket
2096		- ) =
2097		- if frames is
2098		- {
2099		- [ ] then [ ],
2100		- [h . t] then
2101		- if h is frame(height,url,name) then
2102		- [
2103		- "<frame src=\"",add_tickets(c_ticket,s_ticket,url), "\" name=\"",name,"\" frameborder=\"no\" />"
2104		- . format(t,c_ticket,s_ticket)]
2105		- }.
2106		-
2107		-
2108		-define String
2109		- frame_size
2110		- (
2111		- Int s
2112		- ) =
2113		- if s =< 0 then "*" else to_decimal(s).
2114		-
2115		-define String
2116		- frame_stack_rows
2117		- (
2118		- List(VFrame) frames
2119		- ) =
2120		- if frames is
2121		- {
2122		- [ ] then "",
2123		- [h . t] then if h is frame (height,url,name) then
2124		- frame_size(height)+
2125		- if t is
2126		- {
2127		- [ ] then "",
2128		- [_ . _] then ","
2129		- }+frame_stack_rows(t)
2130		- }.
2131		-
2132		-
2133		-
2134		- 'crlf' is defined in 'basis.anubis'.
2135		-
2136		-
2137		-
2138		-define Printable_tree
2139		- standard_headers
2140		- (
2141		- Int size
2142		- ) =
2143		- [
2144		- "HTTP/1.0 200 OK" + crlf +
2145		- "Server: Anubis" + crlf +
2146		- "Content-Type: text/html" + crlf +
2147		- "Content-Length: "+to_decimal(size)+crlf+
2148		- crlf
2149		- ].
2150		-
2151		- define Printable_tree
2152		- download_headers
2153		- =
2154		- [
2155		- "HTTP/1.0 200 OK" + crlf +
2156		- "Content-Type: application/octet-stream" + crlf +
2157		- crlf
2158		- ].
2159		-
2160		-define Printable_tree
2161		- apache_headers
2162		- =
2163		- [
2164		- "Content-type: text/html" + crlf +
2165		- crlf
2166		- ].
2167		-
2168		-
2169		-define String
2170		- empty_javascript_source
2171		- =
2172		- "javascript:'<html><head></head><body></body></html>';".
2173		-
2174		-public type HeaderSort:
2175		- empty,
2176		- anubis,
2177		- apache.
2178		-
2179		-
2180		-define Printable_tree
2181		- format_keywords
2182		- (
2183		- List(String) l
2184		- ) =
2185		- if l is
2186		- {
2187		- [ ] then [ ],
2188		- [h . t] then if t is [ ]
2189		- then [h]
2190		- else [h , ", " . format_keywords(t)]
2191		- }.
2192		-
2193		-define Printable_tree
2194		- format
2195		- (
2196		- WebMeta m
2197		- ) =
2198		- if m is
2199		- {
2200		- keywords(l) then ["<meta name=\"keywords\" content=\"",format_keywords(l),"\">"],
2201		- refresh(url,delay) then ["<meta http-equiv=\"Refresh\" content=\"",delay,"; URL=",url,"\">"],
2202		- meta(n,c) then ["<meta name=\"",n,"\" content=\"",c,"\">"],
2203		- http_equiv(n,c) then ["<meta http-equiv=\"",n,"\" content=\"",c,"\">"]
2204		- }.
2205		-
2206		-define Printable_tree
2207		- format
2208		- (
2209		- List(WebMeta) metas
2210		- ) =
2211		- if metas is
2212		- {
2213		- [ ] then [ ],
2214		- [h . t] then [format(h) . format(t)]
2215		- }.
2216		-
2217		-
2218		-
2219		-
2220		-
2221		-
2222		-public define Printable_tree
2223		- format
2224		- (
2225		- HeaderSort hs,
2226		- String c_ticket,
2227		- String s_ticket,
2228		- Web_page p
2229		- ) =
2230		- if p is
2231		- {
2232		- web_page(title,metas,head_scripts,body) then
2233		- with fullpage =
2234		- [
2235		- "<html>",
2236		- "<head>",
2237		- "<title>", title, "</title>",
2238		- format(metas),
2239		- head_scripts,
2240		- "</head>",
2241		- "<body ",
2242		- if body is body(options,item) then
2243		- with b_options = format(prepare(options)),
2244		- [b_options, " onload='body_onloads();",
2245		- if *images_to_load is [] then "" else " preload_images();",
2246		- "'>",
2247		- load_image_script(*images_to_load),
2248		- reverse(*scripts),
2249		- "<script>",
2250		- " function body_onloads() {",
2251		- format(*body_onloads),
2252		- "}</script>",
2253		- format(c_ticket,s_ticket,item)
2254		- ],
2255		- "</body>",
2256		- "</html>"
2257		- ],
2258		- [
2259		- if hs is
2260		- {
2261		- empty then [ ],
2262		- anubis then standard_headers(length(fullpage)),
2263		- apache then apache_headers
2264		- }
2265		- . fullpage
2266		- ],
2267		- standard_frameset(title,metas,height,width,main) then
2268		- with body =
2269		- [
2270		- "<html>",
2271		- "<head>",
2272		- "<title>", title, "</title>",
2273		- format(metas),
2274		- "</head>",
2275		- "<frameset frameborder=\"no\" border=\"0\" framespacing=\"0\"",
2276		- " marginwidth=\"0\" marginheight=\"0\" cols=\"",width,",\" rows=\"\">",
2277		- " <frame src=\"",empty_javascript_source,"\" name=\"left\" frameborder=\"no\"",
2278		- " marginwidth=\"0\" marginheight=\"0\" scrolling=\"no\">",
2279		- " <frameset frameborder=\"no\" border=\"0\" framespacing=\"0\" rows=\"",height,",\" cols=\"\">",
2280		- " <frame src=\"",empty_javascript_source,"\" name=\"top\"",
2281		- " marginwidth=\"0\" marginheight=\"0\" frameborder=\"no\" scrolling=\"no\">",
2282		- " <frame src =\"", add_tickets(c_ticket,s_ticket,main),
2283		- "\" name=\"main\" marginwidth=\"0\" marginheight=\"0\" frameborder=\"no\">",
2284		- " </frameset>",
2285		- "</frameset>",
2286		- "</html>"
2287		- ],
2288		- [
2289		- if hs is
2290		- {
2291		- empty then [ ],
2292		- anubis then standard_headers(length(body)),
2293		- apache then apache_headers
2294		- }
2295		- . body
2296		- ]
2297		- }.
2298		-
2299		-
2300		-public define Bool
2301		- print
2302		- (
2303		- String c_ticket,
2304		- String s_ticket,
2305		- Web_page p
2306		- ) =
2307		- print(format(anubis,c_ticket,s_ticket,p)).
2308		-
2309		-public define Bool
2310		- print_with_headers
2311		- (
2312		- HeaderSort hs,
2313		- String c_ticket,
2314		- String s_ticket,
2315		- Web_page p
2316		- ) =
2317		- print(format(hs,c_ticket,s_ticket,p)).
2318		-
2319		-public define Bool
2320		- print
2321		- (
2322		- Web_page p
2323		- ) =
2324		- print(format(anubis,"","",p)).
2325		-
2326		-
2327		-
2328		-
2329		-public define Bool
2330		- print_with_headers
2331		- (
2332		- HeaderSort hs,
2333		- Web_page p
2334		- ) =
2335		- print(format(hs,"","",p)).
2336		-
2337		-
2338		-public define Cell
2339		- h_spacer
2340		- (
2341		- Int n
2342		- ) =
2343		- cell([absolute_width(n)],text(" ")).
2344		-
2345		-public define Cell
2346		- v_spacer
2347		- (
2348		- Int n
2349		- ) =
2350		- cell([absolute_height(n)],text(" ")).
2351		-
2352		-public define Cell
2353		- empty = cell([],text(" ")).
2354		-
2355		-
2356		-
2357		- *** Below is a simple gadget for counting visitors. It increments a counter (in a file)
2358		- at each call. The argument is the name of the file (relative to the directory of the
2359		- server), and the file is created automatically. It returns the number of the visitor.
2360		-
2361		-public define Int
2362		- get_visitor_number
2363		- (
2364		- String counter_file_name,
2365		- ) =
2366		- protect
2367		- if (RetrieveResult(Int))retrieve(counter_file_name) is
2368		- {
2369		- cannot_find_file then
2370		- //
2371		- // It's time to create the file.
2372		- //
2373		- if save((Int)1,counter_file_name) is
2374		- {
2375		- cannot_open_file then 0,
2376		- write_error then 0,
2377		- ok then 1
2378		- },
2379		- read_error then 0,
2380		- type_error then 0,
2381		- ok(n) then
2382		- //
2383		- // Increment the counter
2384		- //
2385		- if save(n+1,counter_file_name) is
2386		- {
2387		- cannot_open_file then n,
2388		- write_error then n,
2389		- ok then n+1
2390		- }
2391		- }.
2392		-
2393		-
2394		-
2395		-

web/CXM_multihost_http_server.anubis

Wrap text Show/Hide comments View file @e88c944

Changes suppressed. Click to show

1		-
2		- Project The Anubis Project
3		-
4		- Title A Multi Host HTTP/HTTPS Server
5		-
6		- Copyright Copyright (c) Anubis Team 2003-2007.
7		-
8		-
9		- Authors Alain Prouté
10		- David René
11		- Cédric Ricard
12		-
13		-
14		- Revised July 2007.
15		-
16		-
17		-
18		- Overviews
19		- In this file a HTTP/HTTPS server is defined, which is able to handle multiple hosts
20		- (virtual hosts). It answers HTTP/HTTPS requests, sends files (images or any other kind
21		- of file), constructs HTML pages on the fly using informations received from the client
22		- (when the URI ends by '.awp'), handles uploading of files and redirections. It is
23		- multitasking by itself, and can handle any number of sites and clients simultaneously.
24		- It should better be used in conjunction with 'making_a_web_site.anubis' to be found in
25		- the same directory. If you use 'web/making_a_web_site.anubis', you don't need to read
26		- this file.
27		-
28		-
29		- ----------------------------------- Table of Contents ---------------------------------
30		-
31		- *** (1) Multihosting and redirections.
32		- *** (2) The incompatibility between SSL and virtual hosts.
33		- *** (3) HTTP headers and web arguments.
34		- *** (4) Site descriptions.
35		- *** (5) Protection against denial of service attacks.
36		- *** (6) Starting your HTTP and HTTPS servers.
37		- *** (7) Private download.
38		- *** (8) About web argument names.
39		- *** (9) A web dispatcher.
40		- *** (10) HTTP Errors
41		-
42		- ---------------------------------------------------------------------------------------
43		-
44		-
45		-
46		-
47		- *** (1) Multihosting and redirections.
48		-
49		- This HTTP/HTTPS server can handle several host (also called 'virtual hosts'), in other
50		- words, you may have several sites on the same server, with the same IP address and same
51		- port numbers, but distinct 'host names'.
52		-
53		- A HTTP request sent by a browser contains the following informations:
54		-
55		- - a 'host name',
56		- - an URI (Uniform Resource Identifier),
57		- - HTTP headers,
58		- - web arguments (in the form 'name=value').
59		-
60		- Actually, the host name is just the value of the HTTP header whose name is 'Host'. The
61		- host name indicates which site is requested. Hence, it is the primary information for
62		- branching to the right site. If there is no 'Host' HTTP header in the request, the
63		- request is denied.
64		-
65		- From now on, we may assume that the host is determined, and consequently that we are
66		- concerned by only one site. Each site has his own directories on the server's
67		- disk.
68		-
69		- Each site also has a list of 'redirections'. A redirection is a triplet, like this one:
70		-
71		- redirect("/", "www.our-business.com", "/homepage.awp")
72		-
73		- meaning that if the host is "www.our-business.com", and if the requested URI is "/",
74		- then the URI to be served is "/homepage.awp". 'redirect' is a constructor of the type
75		- 'Redirection' defined in 'web/common.anubis'.
76		-
77		- Now, an URI may end by ".awp" (meaning 'Anubis Web Page') or not. If it does, the
78		- server understands that an HTML page must be constructed on the fly, and to that end it
79		- calls the 'awp handler' of the site. Otherwise, the URI must end by a known extension,
80		- like ".jpg", ".png", ".txt", etc... and represents a file path relative to the
81		- 'public' directory of the site. If these conditions are satisfied, the file is sent to
82		- the client. Known extensions are recorded in 'web/mime.anubis'.
83		-
84		-
85		-
86		-
87		- *** (2) The incompatibility between SSL and virtual hosts.
88		-
89		- Handling virtual hosts makes a problem under SSL (i.e. when using HTTPS), which is due
90		- to the fact that the guys at Netscape who designed SSL probably did not have the
91		- question of virtual hosts in mind. Indeed, the SSL handshake is completed before the
92		- server can know about the value of the 'Host' HTTP header, so that it cannot know which
93		- server certificate must be sent to the client. This makes a problem, because the
94		- browser will not accept a certificate whose common name does not correspond to the name
95		- of the requested host. The user will have to accept the certificate manually, which is
96		- not good for the security image of the site. This problem has at least two solutions
97		- (as far as Anubis is concerned).
98		-
99		- Solution 1. Arrange so that the network interface on which the server is listening
100		- has at least as many different IP addresses as you have virtual hosts. Such
101		- supplementary IP addresses are called 'IP Aliases'. In this case, start one HTTPS
102		- server for each virtual host, each one listening on a different address. For the time
103		- being, this method is applicable under Anubis only if you start as many instances of
104		- 'anbexec' as you have virtual hosts, because each instance of 'anbexec' can handle only
105		- one server certificate. Of course, getting IP aliases is another problem to be solved
106		- with your Internet provider.
107		-
108		- Solution 2. We propose a simple solution, using only one server certificate (hence
109		- only one instance of 'anbexec'). Since, we have only one server certificate, we must
110		- introduce a notion of 'main host', i.e. a host containing all other 'virtual
111		- hosts'. The unique server certificate belong to the main host, so that only the main
112		- host is identified by the client. The client must trust the main host and be confident
113		- that the main host redirects him to the right virtual host. Actually, the process will
114		- be transparent to the client, except that the client will see the name of the main host
115		- instead of the name of the virtual host in the 'location' field of the browser.
116		-
117		- So, assume that the name of main host is 'www.securedhost.com', and that the names of
118		- the virtual hosts are:
119		-
120		- actual name simplified name
121		- -----------------------------------------------------
122		- www.virtual1.com virtual1
123		- www.virtual2.com virtual2
124		- www.virtual3.com virtual3
125		-
126		- Then the (confidential) document '/doc/my_document.pdf' on 'www.virtual2.com' will have
127		- the URL:
128		-
129		- https://www.securedhost.com/virtual2/doc/my_document.pdf
130		-
131		- In order to work transparently, this solution must combine HTTP and HTTPS. Indeed, the
132		- vitual host must have a first page reachable under HTTP, through the URL:
133		-
134		- http://www.virtual2.com/
135		-
136		- The HTTP server will redirect this URL to the awp handler of virtual host 'virtual2'.
137		- The handler of this virtual host is able to generate a first page containing the
138		- following HTML meta:
139		-
140		- <meta http-equiv="Refresh" content="0;URL=https://www.securedhost.com/virtual2/">,
141		-
142		- so that the client is immediately redirected to the main host under HTTPS (hence
143		- accepting tranparently the server certificate). The awp handler of 'virtual2' then
144		- redirects this URL to the home page (maybe a login page) of 'virtual2'.
145		-
146		- See 'web/making_a_web_site.anubis' for the sequel of this story.
147		-
148		-
149		-
150		-
151		-
152		- *** (3) HTTP headers and web arguments.
153		-
154		- Each HTTP request which arrives on the server contains a request line followed by a
155		- series of HTTP headers. Each HTTP header is a pair '(name,value)' assigning a value to
156		- a name. The type 'HTTP_header' is defined in 'web/common.anubis'.
157		-
158		- The request may also have a 'body'. The body contains either 'web arguments' or
159		- uploaded files (or both). The request line itself may also contain web arguments (in a
160		- so-called 'query string'). Like HTTP headers, 'web arguments' are pairs
161		- '(name,value)', but the difference is that these pairs are generated by the page within
162		- which the client clicks, while HTTP headers are generated by the browser itself. The
163		- type 'Web_arg' is defined in 'web/common.anubis'. It has two alternatives, one for
164		- ordinary web arguments (pairs) and one for uploaded files.
165		-
166		-read CXM_common.anubis
167		-read tools/basis.anubis
168		-read tools/printable_tree.anubis
169		-read system/string.anubis
170		-read system/files.anubis
171		-read system/lists.anubis
172		-read web/mime.anubis
173		-
174		-
175		-
176		- *** (4) Site descriptions.
177		-
178		- The type HTTP_Info gathers informations comming along with the client's request. These
179		- informations are rarely used for composing HTML pages. Nevertheless, they are at your
180		- disposal.
181		-
182		-public type HTTP_Info:
183		- http_info
184		- (
185		- Word32 ip_address, // IP address of the client
186		- String hostname, // hostname requested by the client
187		- String uri, // URI requested by the client
188		- List(HTTP_header) http_headers, // HTTP headers sent by the client
189		- Bool is_https,
190		- One -> String generate_trust_ticket // may be used against denial of
191		- // service attacks
192		- ).
193		-
194		-
195		-
196		- Each site is described by a 'web site description', which is a datum of type
197		- 'Web_Site_Description'.
198		-
199		-public type Web_Site_Description:
200		- web_site_description(
201		- List(String) common_names,
202		- String site_directory,
203		- Redirections redirections,
204		- String charset,
205		- List(String) journal_extensions,
206		- List(String) journal_headers,
207		- String authorization_secret,
208		- List(MIME) known_mime_types,
209		- (String host_name,
210		- HTTP_Info http_info,
211		- List(Web_arg) lwa,
212		- Bool is_https) -> (//List(HTTP_header),
213		- Printable_tree) awp_handler,
214		- (HTTP_Info http_info,
215		- List(Web_arg) lwa) -> One before_send_file
216		- //Bool using_state_cookies,
217		- ).
218		-
219		- The component 'common_names' is the list of names of the site, like for example
220		- "www.our-business.com". The reason why we have a list of common names instead of a
221		- single common name, is that it may be useful to have a common name like "192.168.0.1"
222		- for testing.
223		-
224		- 'charset' is a string which will determine the character encoding to be used by the
225		- browser. Typically, this string is one of: "UTF-8", "ISO-8859-1", "Windows-1252",
226		- etc...
227		-
228		- 'journal_extensions' is the list of URI extensions for which you want a log in the
229		- journal (and on the console). When a request arrives, and if the extension is a member
230		- of this list, a message is printed into the journal of the site including the date, the
231		- IP address of the client, the complete HTTP request line. The HTTP headers whose name
232		- is a member of 'journal_headers' are also printed in the journal. A reasonable minimum
233		- for these two components is:
234		-
235		- [".awp"] for journal_extensions
236		- ["user-agent"] for journal_headers
237		-
238		- 'authorization_secret' is a string which should just be unguessable. You may choose
239		- something like (but don't choose this one !):
240		-
241		- "Hg8kJe42gCML9jNH-74"
242		-
243		- i.e. a sequence of characters typed at random, long enough to be unguessable. This is
244		- used by the 'private download' mecanism, which is discussed later in this file.
245		-
246		- The component 'awp_handler' is a function of type:
247		-
248		- (String host_name,
249		- HTTP_Info http_info,
250		- List(Web_arg) web_args,
251		- Bool is_https) -> Printable_tree
252		-
253		- ('Printable_tree' is a substitute for 'String' and is defined in
254		- 'tools/basis.anubis'). This function is the 'awp handler' for the site. When the URI
255		- ends by ".awp", this function is called, and the result (an HTML page) is sent to the
256		- client over the connection. The last operand to this function is a boolean which is
257		- 'true' when the requests arrives through the HTTPS channel, and 'false' when it arrives
258		- through the HTTP channel.
259		-
260		-
261		-
262		-
263		-
264		-
265		-
266		- *** (5) Protection against denial of service attacks.
267		-
268		- We need to protect our servers against 'denial of service' attacks. The attack may be
269		- send automatically from machines which are infested by viruses. In that case, our
270		- server is saturated of connections (all virtual machines at work), but nothing is
271		- comming on the connections. In order to avoid this problem, we propose the following:
272		-
273		- (1) Limit the number of simultaneous connections (say to 100).
274		- (2) Close a connection if the request is not complete after say 10 seconds.
275		- (3) Close the connection if the request is bigger than a given size (normal requests
276		- are small except when there are uploaded files.
277		- (4) Close the connection during the sending of the answer if the client is waiting
278		- too much.
279		- (5) Record all IP addresses with which we have encountered one of the problems above.
280		- (6) Immediately close the connections if the IP address is in our list.
281		- (7) Remove an address from the list only after 5 minutes of inactivity of this
282		- address.
283		- (8) Maintain a list of reliable IP addresses.
284		-
285		- Of course, all the above are approximative solutions which may in some circumstances
286		- become either cumbersome or also partially block the system. So, it is needed to have a
287		- set of dynamically modifiable parameters in order to master the behavior of this
288		- mecanism.
289		-
290		-
291		- Each dubious IP address is recorded together with its last activity time.
292		-
293		-public type DubiousIP:
294		- dubious_ip (Word32 address,
295		- Int last_activity).
296		-
297		-
298		-public type DenialOfService:
299		- denial_of_service(Var(Int) max_connections,
300		- Var(Int) request_line_delay, // seconds
301		- Var(Int) headers_delay,
302		- Var(Int) answer_delay,
303		- Var(List(DubiousIP)) list_of_dubious,
304		- Var(List(Word32)) reliable_addresses).
305		-
306		- The informations in this set of variables are stored serialized into the file
307		- 'my_anubis/web_sites/dos_info'. If this file does not exist a set if variables with
308		- default values is created. The values are saved on the disk each time they are
309		- modified.
310		-
311		-public define DenialOfService load_denial_of_service_info.
312		-
313		-
314		-
315		- *** (6) Starting your HTTP and HTTPS servers.
316		-
317		- When your web site descriptions are ready, you can start a pair of servers (a HTTP
318		- server and a HTTPS server) for serving your web sites. Notice that there are always
319		- two servers, regardless of the number of web sites, and that each web sites normally
320		- uses the two servers.
321		-
322		-
323		-public define StartServerResult
324		- start_http_server
325		- (
326		- Word32 ip_address,
327		- Word32 http_port,
328		- List(Web_Site_Description) web_sites,
329		- DenialOfService dos
330		- ).
331		-
332		-public define StartServerResult
333		- start_https_server
334		- (
335		- Word32 ip_address,
336		- Word32 https_port,
337		- String certificate_common_name,
338		- List(Web_Site_Description) web_sites,
339		- DenialOfService dos
340		- ).
341		-
342		- The first argument 'ip_address' is the IP address on which the servers listen. If you
343		- put 0, the servers listen on all adresses of the machine (which is useful if the
344		- machine has several network interfaces). Otherwise, use the function 'ip_address'
345		- defined in 'tools/basis.anubis' for composing a particular IP address.
346		-
347		- The next arguments are the port numbers for HTTP and HTTPS. The usual values are 80 and
348		- 443, but you may have reasons to choose other values.
349		-
350		- The next argument is the list of your web site descriptions. All the sites described in
351		- this list will be accessible on the server.
352		-
353		- The argument 'dos' is a set of dynamic variables containing the informations for
354		- protecting the servers against denial of service attacks.
355		-
356		-
357		-
358		-
359		-
360		-
361		- *** (7) Private download.
362		-
363		- It may happen that you want to propose private files for download. This means that such
364		- a file could be downloaded only by the authorized person, and should not be seen by any
365		- other one. This feature can be used only under HTTPS, not under HTTP.
366		-
367		- The file may be located anywhere on the server. Hence, the file has a complete absolute
368		- path, like for example:
369		-
370		- /home/georges/my_documents/my_text.pdf
371		-
372		- which has nothing to do with the directories of the web server. Now, you may also want
373		- to show another path or simply just a name to the client, not the actual absolute path
374		- above, which may need to remain secret. So for example, the same file may appear to the
375		- client as:
376		-
377		- informations.pdf
378		-
379		- The page must provide a link with an authorization. The authorization is just a web
380		- argument, whose name is "zauth". The value of this web argument is computed by hashing
381		- some secret string (known only from the programmer of the web site) with the absolute
382		- path of the file. The HTTPS request will have the form:
383		-
384		- GET /informations.pdf?zauth=d38161f5b4e87e2d46e06ff8b3e233be563794d1
385		-
386		- The server will search for a file named
387		-
388		- zd38161f5b4e87e2d46e06ff8b3e233be563794d1
389		-
390		- (i.e. "z" concatenated with the value of the authorization) in the subdirectory
391		- 'private_download' of the site directory. This file contains the absolute path of the
392		- file, i.e:
393		-
394		- /home/georges/my_documents/my_text.pdf
395		-
396		- At that point, the server may hash the secret string and the absolute path together, to
397		- check if the client is authorized to download the file. If it is the case, it sends the
398		- file (the MIME type is declared as 'application/octet-stream' if it is not recognized).
399		- The file is sent under the visible name.
400		-
401		- The server creates automatically the subdirectory 'private_download/' within the 'site
402		- directory' (for each web site) if it does not already exist. Files in this directory
403		- are deleted when they become too old (for example, after 3 days of life).
404		-
405		- Here is the function for computing the value of the authorization, and for making the
406		- authorization file in 'private_download'.
407		-
408		-public define String
409		- make_authorization
410		- (
411		- String site_directory,
412		- String authorization_secret, // known only by the programmer of the web site
413		- String absolute_path // on server
414		- ).
415		-
416		- See 'web/making_a_web_site.anubis' for the construction of the link for downloading.
417		-
418		-
419		-
420		-
421		-
422		-
423		-
424		-
425		- *** (8) About web argument names.
426		-
427		- The server reserves the name "zauth" for the authorization in the private download
428		- mecanism. Also, if the name of a web arguments begins by "p" (like 'password'), it does
429		- not print the value of the web argument neither on the console or in the journal. A
430		- good politics is to prefix all web arguments by letters distinct from 'p' and 'z'. This
431		- method is used in 'web/making_a_web_site.anubis'. This will avoid clashes of names.
432		-
433		-
434		-
435		-
436		-
437		-
438		- *** (9) A web dispatcher.
439		-
440		- For hosting several sites you may prefer another method which we now describe. We start
441		- a HTTP server on port 80 (or on another port). This server is called the
442		- ``dispatcher''. When a requests arrives, the dispatcher examines the ``host'' HTTP
443		- header, so that it gets the name of the requested host. Then it sends to the client a
444		- page like this one:
445		-
446		- <html>
447		- <head>
448		- <meta http-equiv="Refresh" content="0;URL=...">
449		- </head>
450		- <body>
451		- </body>
452		- </html>
453		-
454		- where the URL represented by '...' is the URL of the requested site. This URL may have
455		- the same IP address as the dispatcher, except that the port number is different. It may
456		- also have a different IP address.
457		-
458		- The dispatcher uses the file 'my_anubis/web_sites/dispatcher.info'. This file contains
459		- a serialized datum of type 'List(DispatcherInfo)'.
460		-
461		-public type DispatcherInfo:
462		- site(String common_name,
463		- Word32 http_port).
464		-
465		- The dispatcher does not write into this file. It reads it when it starts, and rereads
466		- it each time the date of last modification of the file changes, so that the dispatcher
467		- always has up to date data. The file may be managed (written and updated) by another
468		- program.
469		-
470		- So, for each site, the dispatcher knows the common name (needed to recognize the 'host'
471		- HTTP header), and the pair (ip_address,port) used by the actual site for HTTP. The
472		- dispatcher does not worry about HTTPS. HTTPS must be managed by the actual site.
473		-
474		- The dispatcher is started by:
475		-
476		-public define One
477		- start_web_dispatcher
478		- (
479		- Word32 ip_address, // address for listening (typically 0)
480		- Word32 port, // typically 80
481		- DenialOfService dos
482		- ).
483		-
484		- A command line tool for managing the file 'my_anubis/web_sites/dispatcher.info' is also
485		- provided:
486		-
487		- global define One
488		- manage_web_dispatcher
489		- (
490		- List(String) args
491		- ).
492		-
493		-
494		- *** (10) HTTP Errors
495		-
496		-public type HTTP_Status:
497		- http_continue, // 100
498		- http_switching_protocol, // 101
499		-
500		- http_ok, // 200
501		- http_created, // 201
502		- http_accepted, // 202
503		- http_non_authoritative_info, // 203
504		- http_no_content, // 204
505		- http_reset_content, // 205
506		- http_partial_content, // 206
507		-
508		- http_multiple_choices,
509		- http_moved_permanently(String location), // 301
510		- http_moved_temporarily(String location), // 302
511		- http_see_other(String location), // 303
512		- http_not_modified, // 304
513		- http_use_proxy(String location), // 305
514		- http_temporary_redirect(String location), // 307
515		-
516		- http_bad_request, // 400
517		- http_unauthorized, // 401
518		- http_payment_required, // 402
519		- http_forbidden, // 403
520		- http_not_found, // 404
521		- http_method_not_allowed, // 405
522		- http_not_acceptable, // 406
523		- http_proxy_authentification_required, // 407
524		- http_request_timeout, // 408
525		- http_conflict, // 409
526		- http_gone, // 410
527		- http_length_required, // 411
528		- http_precondition_failed, // 412
529		- http_request_entity_too_large, // 413
530		- http_request_uri_too_long, // 414
531		- http_unsupported_media_type, // 415
532		- http_request_range_unsatisfiable, // 416
533		- http_expectation_failed, // 417
534		-
535		- http_internal_server_error, // 500
536		- http_not_implemented, // 501
537		- http_bad_gateway, // 502
538		- http_service_unavailable, // 503
539		- http_gateway_timeout, // 504
540		- http_version_not_supported, // 505
541		-
542		- http_error(Int /code/, String /message/).
543		-
544		-public define (String, List(HTTP_header))
545		- format
546		- (
547		- HTTP_Status status
548		- ).
549		-
550		-
551		-
552		-
553		-
554		- --- That's all for the public part ! --------------------------------------------------
555		-
556		-define Maybe(String) get_host_header_value(List(HTTP_header) headers).
557		-
558		-define String
559		- __utime_to_string
560		- (
561		- UTime t
562		- ) =
563		- to_decimal(t.seconds) + "." + zero_pad_n(6, t.microseconds ) + "s".
564		-
565		-
566		-variable UTime t0 = utime(0,0).
567		-variable UTime t1 = utime(0,0).
568		-
569		-define One
570		- accumulate_t1
571		- (
572		- UTime start
573		- ) =
574		- with delta = (UTime)unow - start,
575		- t1 <- delta + *t1;
576		- unique.
577		-
578		-variable UTime t2 = utime(0,0).
579		-
580		-define One
581		- accumulate_t2
582		- (
583		- UTime start
584		- ) =
585		- with delta = (UTime)unow - start,
586		- t2 <- delta + *t2;
587		- unique.
588		-
589		-
590		-public define One
591		- print_delta
592		- (
593		- String txt
594		- ) =
595		- println(__utime_to_string((UTime)unow - *t0) + " : " + txt).
596		-
597		-
598		- ----------------------------------- Table of Contents ---------------------------------
599		-
600		- *** [1] Types which are private to this file.
601		-
602		- *** [2] Tools.
603		- *** [2.1] Formating an error message.
604		- *** [2.2] Converting IP addresses.
605		- *** [2.3] Reading and unputting characters.
606		- *** [2.4] Reading and discarding characters.
607		- *** [2.5] Reading a character string.
608		- *** [2.6] Padding integers with zeros.
609		- *** [2.7] Converting web arguments to ASCII.
610		- *** [2.8] Server description.
611		-
612		- *** [3] Managing the journal.
613		- *** [3.1] Naming journal files.
614		- *** [3.2] Formating HTTP headers.
615		- *** [3.3] Formating web arguments.
616		- *** [3.4] Formating the whole request.
617		- *** [3.5] Putting it in the journal file (and on the console).
618		-
619		- *** [4] Reading the HTTP request.
620		- *** [4.1] Skipping leading blanks.
621		- *** [4.2] Reading a new line.
622		- *** [4.3] Reading a 'word'.
623		- *** [4.4] Separating the URI from the query string.
624		- *** [4.5] Reading the web arguments.
625		- *** [4.7] Reading the request line.
626		- *** [4.8] Reading the HTTP headers.
627		- *** [4.9] Getting the size of the request's body.
628		- *** [4.10] Reading the body of the request.
629		-
630		- *** [5] Making the HTTP answer.
631		- *** [5.1] Avoiding illegal URIs.
632		- *** [5.2] Managing authorizations for downloading private files.
633		- *** [5.3] Recognizing MIME types.
634		- *** [5.4] Formating HTTP headers.
635		- *** [5.5] Sending a file.
636		- *** [5.6] Answering a www-url encoded request.
637		- *** [5.7] Answering a multipart/form-data encoded request.
638		- *** [5.7.1] Finding the boundary.
639		- *** [5.7.2] Reading attributes from a multipart entity.
640		- *** [5.7.3] Creating a temporary filename for an uploaded file.
641		- *** [5.7.4] Saving an uploaded file under a temporary filename.
642		- *** [5.7.5] Removing the path from a file name.
643		- *** [5.7.6] Reading a multipart entity.
644		- *** [5.8] Handling redirections.
645		- *** [5.9] Answering both sorts of requests.
646		-
647		- *** [6] The HTTP/HTTPS servers.
648		- *** [6.1] The HTTP request handler.
649		- *** [6.2] Server's tasks.
650		- *** [6.3] Starting the HTTP/HTTPS servers.
651		-
652		- *** [7] The web dispatcher.
653		- *** [7.1] The dispatcher server.
654		- *** [7.2] The dispatcher web site.
655		- *** [7.3] Managing the info file.
656		-
657		- ---------------------------------------------------------------------------------------
658		-
659		-
660		-
661		-
662		-read tools/basis.anubis
663		-read tools/findstring.anubis
664		-read tools/connections.anubis
665		-
666		-
667		-
668		-
669		-
670		- *** [1] Types which are private to this file.
671		-
672		- We use the following self-explanatory types.
673		-
674		-type Error:
675		- cannot_read_from_connection,
676		- not_get_or_post_request(String),
677		- end_of_line_expected,
678		- incorrect_content_length_value,
679		- colon_expected,
680		- timeout(Int).
681		-
682		-type HTTP_RequestType:
683		- get,
684		- post.
685		-
686		-type HTTP_RequestLine:
687		- request_line (HTTP_RequestType type,
688		- String uri,
689		- List(Web_arg) query_string).
690		-
691		-type EncodingType:
692		- www_url,
693		- multipart_form_data.
694		-
695		-type BufferedConnection:
696		- buffered_connection(Connection conn,
697		- Var(ByteArray) buffer,
698		- Var(Int) read_pos).
699		-
700		-
701		-
702		- *** [2] Tools.
703		-
704		- *** [2.1] Formating an error message.
705		-
706		- The next function formats an error message.
707		-
708		-define String
709		- format
710		- (
711		- Error msg
712		- ) =
713		- if msg is
714		- {
715		- cannot_read_from_connection then
716		- "Cannot read from connection.\n",
717		- not_get_or_post_request(s) then
718		- "The request did not begin by 'GET' or 'POST': "+s+".\n",
719		- end_of_line_expected then
720		- "End of line expected.\n",
721		- incorrect_content_length_value then
722		- "Incorrect value for HTTP header 'Content-Length'.\n",
723		- colon_expected then
724		- "':' was expected.\n",
725		- timeout(n) then
726		- //"time out: "+n+"\n"
727		- //"time out.\n"
728		- ""
729		- }.
730		-
731		-
732		-
733		-
734		-
735		-
736		- *** [2.2] Converting IP addresses.
737		-
738		- We need two conversion functions for IP addresses:
739		-
740		- (Word8,Word8,Word8,Word8) --> Word32 ip_address
741		- Word32 --> String ip_addr_to_string
742		-
743		- These conversions are defined in 'tools/basis.anubis'.
744		-
745		-
746		-
747		-
748		-
749		-
750		-
751		-
752		- *** [2.3] Reading and unputting characters.
753		-
754		- We need a mecanism for unputting several characters (actually at least 3). This is
755		- because when reading the client connection, we must sometimes go ahead several
756		- characters, and virtually put them back into the connection, so that they can be
757		- reread. Of course, we do not send them back to the client. We store them in a list
758		- (hold by the variable 'unput_chars'), and we manage this list, so that characters may
759		- be virtually put back in the connection (this is called 'unputting').
760		-
761		-variable List(Word8) unput_chars = [].
762		-
763		- The most recently read one is the head of list. Fortunately, this variable is private
764		- to this virtual machine (hence to this client).
765		-
766		-
767		-define One
768		- unput // unputting a character (add it in front of the list)
769		- (
770		- Word8 character
771		- ) =
772		- unput_chars <- (List(Word8))[character . *unput_chars].
773		-
774		-
775		-
776		-define One record_dubious_IP(Word32 addr,DenialOfService dos).
777		-
778		-variable Int sttm = 0. // contains the start time for this connection.
779		-
780		-define Result(Error,Word8)
781		- record_dubious_connection
782		- (
783		- Connection conn,
784		- Int dead_line,
785		- DenialOfService dos,
786		- ) =
787		- if remote_IP_address_and_port(conn) is (addr,port) then
788		- record_dubious_IP(addr,dos);
789		- print("Recording IP address "+ip_addr_to_string(addr)+
790		- " as dubious after "+(dead_line-*sttm)+" seconds. Total: "+
791		- length(*list_of_dubious(dos))+"\n");
792		- error(timeout(dead_line)).
793		-
794		-define String
795		- pid
796		- =
797		- "[" + virtual_machine_id + "] ".
798		-
799		-
800		-define One
801		- put
802		- (
803		- ByteArray source,
804		- ByteArray dest,
805		- Int position,
806		- Int i
807		- ) =
808		- if nth(i,source) is
809		- {
810		- failure then unique,
811		- success(b) then if put(dest,position,b) is
812		- {
813		- failure then unique,
814		- success(_) then put(source,dest,position+1,i+1)
815		- }
816		- }.
817		-
818		-define ReadResult
819		- read_from_connexion
820		- (
821		- BufferedConnection connection,
822		- Int size,
823		- Int time_out,
824		- ByteArray result_buffer,
825		- Int position
826		- ) =
827		- //println(pid + "read_from_connexion(" + size + ")");
828		-
829		- if connection.read_pos < length(connection.buffer) then
830		- //println(pid + " reading from buffer (size = " + length(connection.buffer) + ", pos = " + connection.read_pos);
831		- //with t1_tmp = (UTime) unow,
832		- with result = extract(connection.buffer, connection.read_pos, *connection.read_pos + size),
833		- size_read = length(result),
834		- put(result,result_buffer,position,0);
835		- connection.read_pos <- *connection.read_pos + size_read;
836		- //accumulate_t1(t1_tmp);
837		- if size > size_read then
838		- //println("Wanted " + size + ", read only " + size_read);
839		-
840		- terminal read_from_connexion(connection, size - size_read, time_out, result_buffer,position+size_read)
841		-// {
842		-// error then error,
843		-// timeout then ok(result),
844		-// ok(ba) then ok(result + ba)
845		-// }
846		- else
847		- ok(result_buffer)
848		- else
849		- //if unow > dead_line then record_dubious_connection(connection,dead_line,dos) else
850		- if read(connection.conn, 16384, time_out) is // the connection is closed after 10 minutes of inactivity
851		- {
852		- error then println(pid + "read failed)"); error,
853		- timeout then timeout,
854		- ok(ba) then
855		-// println(pid + "ba = " + length(ba));
856		- connection.buffer <- ba;
857		- connection.read_pos <- 0;
858		- //println(pid + "rb = " + length(*read_buffer));
859		-
860		- terminal read_from_connexion(connection, size, time_out, result_buffer,position)
861		- }.
862		-
863		-define Result(Error,Word8)
864		- next_char // reading a character (check the list first, and read on the connection
865		- // only when the list is empty).
866		- (
867		- BufferedConnection connection,
868		- Int dead_line,
869		- DenialOfService dos
870		- ) =
871		- //with t2_tmp = (UTime) now,
872		- if *unput_chars is
873		- {
874		- [ ] then
875		- // ///////////////////
876		- // Buffered reading
877		- //if unow > dead_line then record_dubious_connection(connection,dead_line,dos) else
878		- if nth(connection.read_pos, connection.buffer) is
879		- {
880		- failure then
881		- if read_from_connexion(connection,1,600, constant_byte_array(1,0),0) is // the connection is closed after 10 minutes of inactivity
882		- {
883		- error then /accumulate_t2(t2_tmp);/ error(cannot_read_from_connection),
884		- timeout then /accumulate_t2(t2_tmp);/ error(timeout(600)),
885		- //record_dubious_connection(connection,dead_line,dos),
886		- ok(ba) then if nth(0,ba) is
887		- {
888		- failure then /accumulate_t2(t2_tmp);/ error(cannot_read_from_connection),
889		- success(c) then
890		- //println("-" + pid + "read [" + implode([c]) + "]\t");
891		- //accumulate_t2(t2_tmp);
892		- ok(c)
893		- }
894		- },
895		- success(c) then
896		- connection.read_pos <- *connection.read_pos + 1;
897		- //accumulate_t2(t2_tmp);
898		- ok(c)
899		- },
900		-
901		- // ///////////////////
902		- // standard reading
903		-// if read(connection.conn, 1, 600) is // the connection is closed after 10 minutes of inactivity
904		-// {
905		-// error then accumulate_t2(t2_tmp); println(pid + "read failed)"); error(cannot_read_from_connection),
906		-// timeout then accumulate_t2(t2_tmp); error(timeout(600)),
907		-// ok(ba) then if nth(0,ba) is
908		-// {
909		-// failure then accumulate_t2(t2_tmp); error(cannot_read_from_connection),
910		-// success(c) then accumulate_t2(t2_tmp);
911		-// ok(c)
912		-// }
913		-// },
914		-
915		- [h . t] then
916		- unput_chars <- t; //accumulate_t2(t2_tmp);
917		- ok(h)
918		- }.
919		-
920		-
921		-
922		-
923		-
924		-
925		- *** [2.4] Reading and discarding characters.
926		-
927		- The next function reads the specified number of bytes (this is the same as
928		- 'characters') from the connection and discards them. This is used for discarding CR LF
929		- just before the body of a request.
930		-
931		-define Result(Error,One)
932		- read_and_ignore
933		- (
934		- BufferedConnection connection, // to client
935		- Int dead_line,
936		- Int number_of_characters, // number of characters to read and ignore
937		- DenialOfService dos
938		- ) =
939		- if number_of_characters =< 0 then ok(unique) else
940		- if next_char(connection, dead_line, dos) is
941		- {
942		- error(msg) then error(msg),
943		- ok(c) then read_and_ignore(connection,dead_line,number_of_characters-1,dos)
944		- }.
945		-
946		-
947		-
948		-
949		-
950		-
951		-
952		- *** [2.5] Reading a character string.
953		-
954		- Sometimes values of HTTP attributes or web args are presented in the form of double
955		- quoted strings. The next function handles the reading of such things. The leading
956		- double quote is already read in. We must read subsequent characters until the next non
957		- backslashed double quote.
958		-
959		-define Result(Error,String)
960		- read_string
961		- (
962		- BufferedConnection connection, // connection with the client
963		- Int dead_line,
964		- List(Word8) so_far, // characters read so far (in reverse order)
965		- DenialOfService dos
966		- ) =
967		- if next_char(connection, dead_line,dos) is
968		- {
969		- error(msg) then error(msg),
970		- ok(c) then
971		- if c = '\\'
972		- then if next_char(connection,dead_line,dos) is
973		- {
974		- error(msg) then error(msg),
975		- ok(d) then
976		- if d = '\"'
977		- then read_string(connection,dead_line,['\"' . so_far],dos)
978		- else read_string(connection,dead_line,[d, c . so_far],dos)
979		- }
980		- else if c = '\"'
981		- then ok(implode(reverse(so_far)))
982		- else read_string(connection,dead_line,[c . so_far],dos)
983		- }.
984		-
985		-
986		-
987		-
988		-
989		-
990		-
991		-
992		-
993		-
994		-
995		-
996		- *** [2.7] Converting web arguments to ASCII.
997		-
998		- The function 'web_to_ascii' gets a character string and replaces web encoding by normal
999		- ASCII encoding. This amounts to replacing:
1000		-
1001		- + by blank
1002		- %xx by the character whose ASCII code is xx in hexadecimal
1003		-
1004		- Note: We assume that '9' < 'A' (which is the case for ASCII code).
1005		-
1006		-
1007		-
1008		-define Word8
1009		- web_decode
1010		- (
1011		- Word8 x1,
1012		- Word8 x2
1013		- ) =
1014		- with n1 = if x1 +=< '9' then (x1 - '0') else if x1 +=< 'F' then (x1 - 'A' + 10) else (x1 - 'a' + 10),
1015		- n2 = if x2 +=< '9' then (x2 - '0') else if x2 +=< 'F' then (x2 - 'A' + 10) else (x2 - 'a' + 10),
1016		- (n1 << 4) + n2.
1017		-
1018		-
1019		-
1020		-define String
1021		- web_to_ascii
1022		- (
1023		- String web_string,
1024		- Int n, // current position in web_string
1025		- List(Word8) so_far
1026		- ) =
1027		- if nth(n,web_string) is
1028		- {
1029		- failure then implode(reverse(so_far)),
1030		- success(c) then
1031		- if c = '+'
1032		- then web_to_ascii(web_string,n+1,[' ' . so_far])
1033		- else if c = '%'
1034		- then if nth(n+1,web_string) is
1035		- {
1036		- failure then implode(reverse(so_far)),
1037		- success(x1) then if nth(n+2,web_string) is
1038		- {
1039		- failure then implode(reverse(so_far)),
1040		- success(x2) then web_to_ascii(web_string,n+3,[web_decode(x1,x2) . so_far])
1041		- }
1042		- }
1043		- else web_to_ascii(web_string,n+1,[c . so_far])
1044		- }.
1045		-
1046		-
1047		-
1048		-
1049		-
1050		-
1051		-
1052		-
1053		- *** [3] Managing the journal.
1054		-
1055		- Concurrently working machines should not try to access the same file at the same
1056		- time. This problem may be solved by using the 'protect' mecanism.
1057		-
1058		-
1059		-
1060		- *** [3.1] Naming journal files.
1061		-
1062		- Since journal messages are rather prolific, we should have at least one file per
1063		- hour. Hence, the name of a journal file must be constructed from the current year,
1064		- month, day and hour. For example, it may be:
1065		-
1066		- 2003_03_12_19
1067		-
1068		- (this is for the journal of 7 PM to 8 PM, 2003/mar/12).
1069		-
1070		-define String
1071		- make_current_journal_file_name
1072		- =
1073		- if convert_time(now) is date_and_time(y,m,d,h,_,_,_,_,_) then
1074		- to_decimal(y)+"_"+
1075		- zero_pad_n(2,m)+"_"+
1076		- zero_pad_n(2,d)+"_"+
1077		- zero_pad_n(2,h).
1078		-
1079		-
1080		-
1081		-
1082		-
1083		-
1084		-
1085		- *** [3.2] Formating HTTP headers.
1086		-
1087		- HTTP headers may be shown on the console or written in the journal. The function below
1088		- formats a list of HTTP headers.
1089		-
1090		-define String
1091		- show_format
1092		- (
1093		- Web_Site_Description desc,
1094		- List(HTTP_header) headers,
1095		- ) =
1096		- if headers is
1097		- {
1098		- [ ] then "",
1099		- [h . t] then if h is http_header(name,value) then
1100		- if member(journal_headers(desc),name)
1101		- then " \| "+name+": "+value+"\n"+show_format(desc,t)
1102		- else show_format(desc,t)
1103		- }.
1104		-
1105		-
1106		-
1107		-
1108		-
1109		-
1110		- *** [3.3] Formating web arguments.
1111		-
1112		- The same thing for web arguments.
1113		-
1114		-define String
1115		- show_format
1116		- (
1117		- List(Web_arg) lwa
1118		- ) =
1119		- if lwa is
1120		- {
1121		- [ ] then "",
1122		- [h . t] then if h is
1123		- {
1124		- web_arg(n,v) then
1125		- " \| "+n+"="+(if nth(0,n) = success('p') then "<not shown>" else v)+"\n"+show_format(t),
1126		- upload(n,fn,tfn) then
1127		- " \| "+n+"="+fn+" (uploaded as '"+tfn+"')\n"+show_format(t)
1128		- }
1129		- }.
1130		-
1131		-
1132		-
1133		-
1134		-
1135		-
1136		- *** [3.4] Formating the whole request.
1137		-
1138		- It is cheap to transform month numbers into abbreviated month names. This enhances the
1139		- readability of the journal.
1140		-
1141		-define String
1142		- format_month
1143		- (
1144		- Int m
1145		- ) =
1146		- if m = 1 then "jan" else
1147		- if m = 2 then "feb" else
1148		- if m = 3 then "mar" else
1149		- if m = 4 then "apr" else
1150		- if m = 5 then "may" else
1151		- if m = 6 then "jun" else
1152		- if m = 7 then "jul" else
1153		- if m = 8 then "aug" else
1154		- if m = 9 then "sep" else
1155		- if m = 10 then "oct" else
1156		- if m = 11 then "nov" else
1157		- if m = 12 then "dec" else
1158		- "???".
1159		-
1160		-
1161		- Below we format a whole HTTP request. This may give this (actually, it depends on how
1162		- you defined the values of 'journal_headers' and 'journal_extensions'):
1163		-
1164		- [3] 2003/mar/10 10:06:57 from 123.456.123.456: /homepage.awp
1165		- \| host: www.the-best-one.com
1166		- \| user-agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0
1167		-
1168		- The leading number between brackets is the number of the virtual machine which served
1169		- the URI.
1170		-
1171		-define String
1172		- format_request
1173		- (
1174		- Web_Site_Description desc,
1175		- Connection client_connection,
1176		- HTTP_RequestLine request_line,
1177		- List(HTTP_header) headers,
1178		- List(Web_arg) web_args
1179		- ) =
1180		- with dt = convert_time(now),
1181		- if remote_IP_address_and_port(client_connection) is (addr,port) then
1182		- to_decimal(year(dt))+"/"+format_month(month(dt))+"/"+zero_pad_n(2,day(dt))+" "+
1183		- zero_pad_n(2,hour(dt))+":"+zero_pad_n(2,minute(dt))+":"+zero_pad_n(2,second(dt))+
1184		- " from "+ip_addr_to_string(addr)+
1185		- ": "+uri(request_line)+"\n"+
1186		- show_format(desc,headers)+
1187		- show_format(web_args).
1188		-
1189		-
1190		-
1191		-
1192		-
1193		-
1194		-
1195		- *** [3.5] Putting it in the journal file (and on the console).
1196		-
1197		- We must not forget to 'protect' this operation, so that the messages of two machines
1198		- (working for the same site) will not be mixed together.
1199		-
1200		-define One
1201		- log_journal_msg
1202		- (
1203		- Web_Site_Description desc,
1204		- String msg,
1205		- ) =
1206		- with ba_msg = to_byte_array("["+virtual_machine_id+"] "+msg+"\n"),
1207		- protect
1208		- (
1209		- if file(site_directory(desc)+"/journal/"+make_current_journal_file_name,append) is
1210		- {
1211		- failure then unique,
1212		- success(journal_file) then
1213		- forget(reliable_write(file(journal_file),ba_msg))
1214		- };
1215		- forget(reliable_write(file(stdout),ba_msg))
1216		- ).
1217		-
1218		-
1219		-
1220		-
1221		-
1222		-
1223		-
1224		- *** [4] Reading the HTTP request.
1225		-
1226		-
1227		- *** [4.1] Skipping leading blanks.
1228		-
1229		- One of the peculiarities of HTTP is that the characters 13 (carriage return) and 10
1230		- (line feed) followed by either a space (32) or a tab (9), is considered as a blank not
1231		- containing any new line. 'skip_http_blanks' must skip all blanks characters until the
1232		- first non blank character, which should not be read in. Obviously, because of the above
1233		- peculiarity, we need at least 3 characters of lookahead to do this. In other words, we
1234		- must be able to unput at least 3 characters (hopefully we are).
1235		-
1236		- Strictly blanks characters are 'space' and 'tab'.
1237		-
1238		-define Bool
1239		- is_strict_blank
1240		- (
1241		- Word8 c
1242		- ) =
1243		- if c = ' ' then true else c = '\t'.
1244		-
1245		-
1246		- On the contrary, blanks include 13 and 10.
1247		-
1248		-define Bool
1249		- is_blank
1250		- (
1251		- Word8 c
1252		- ) =
1253		- if c = ' ' then true else
1254		- if c = '\t' then true else
1255		- if c = 13 then true else
1256		- c = 10.
1257		-
1258		-
1259		- Skipping HTTP blanks.
1260		-
1261		-define Result(Error,One)
1262		- skip_http_blanks
1263		- (
1264		- BufferedConnection connection,
1265		- Int dead_line,
1266		- DenialOfService dos
1267		- ) =
1268		- if next_char(connection,dead_line,dos) is
1269		- {
1270		- error(msg) then error(msg),
1271		- ok(c) then
1272		- if is_strict_blank(c)
1273		- then skip_http_blanks(connection,dead_line,dos)
1274		- else if c = 13
1275		- then if next_char(connection,dead_line,dos) is
1276		- {
1277		- error(msg) then error(msg), // (unput(c); ok(unique)),
1278		- ok(d) then
1279		- if d = 10
1280		- then if next_char(connection,dead_line,dos) is
1281		- {
1282		- error(msg) then error(msg), // (unput(d); unput(c); ok(unique)),
1283		- ok(e) then
1284		- if is_strict_blank(e)
1285		- then skip_http_blanks(connection,dead_line,dos)
1286		- else (unput(e); unput(d); unput(c); ok(unique))
1287		- }
1288		- else (unput(d); unput(c); ok(unique))
1289		- }
1290		- else (unput(c); ok(unique))
1291		- }.
1292		-
1293		-
1294		-
1295		-
1296		-
1297		-
1298		-
1299		-
1300		- *** [4.2] Reading a new line.
1301		-
1302		- Normally in HTTP a new line is the sequence 13 10 (carriage return line feed), not
1303		- followed by a space or tabulator. If it is followed by a space or tabulator, the three
1304		- characters are considered blanks, and no new line has been read. Before trying to read
1305		- a new line, we first skip leading spaces and tabs. Then we try to read 13 and 10, and
1306		- we read another character. if this character is space or tab, we consider we have read
1307		- only blanks and we continue reading in order to find our new line. Otherwise, we unput
1308		- this character (which may be for example the first character of the name of the next
1309		- header), and answer that we have seen a new line.
1310		-
1311		- Warning: we must not use this function for reading the last pair (13,10) before the
1312		- beginning of the body, because if the body is empty, there is no character to read
1313		- after this pair, so that the server could wait for a character which will never
1314		- come. This is the reason for 'read_and_ignore' above, which is used precisely for
1315		- reading that last (13,10) pair.
1316		-
1317		-define Result(Error,One)
1318		- read_new_line
1319		- (
1320		- BufferedConnection connection,
1321		- Int dead_line,
1322		- DenialOfService dos
1323		- ) =
1324		- if skip_http_blanks(connection,dead_line,dos) is
1325		- {
1326		- error(msg) then error(msg),
1327		- ok(_) then
1328		- if next_char(connection,dead_line,dos) is
1329		- {
1330		- error(msg) then error(msg),
1331		- ok(c) then
1332		- if c = 13
1333		- then if next_char(connection,dead_line,dos) is
1334		- {
1335		- error(msg) then error(msg),
1336		- ok(d) then
1337		- if d = 10
1338		- then ok(unique)
1339		- else (unput(d);
1340		- unput(c);
1341		- error(end_of_line_expected))
1342		- }
1343		- else (unput(c);
1344		- error(end_of_line_expected))
1345		- }}.
1346		-
1347		-
1348		-
1349		-
1350		-
1351		-
1352		-
1353		-
1354		- *** [4.3] Reading a 'word'.
1355		-
1356		- A 'word' is a sequence of characters which begins either by a double quote or not by a
1357		- double quote. (However, any leading blanks are read in and ignored. This is
1358		- accomplished by 'skip_http_blanks'.) If it begins by a double quote, it is read like a
1359		- string, i.e. it ends at the next (non backslashed) double quote. Otherwise, it is
1360		- right delimited by any character which may be considered as 'blank'. If the word is
1361		- double quoted, the closing double quote is read in. On the contrary, if the word is not
1362		- double quoted, the right delimiting blank character is not read in (it is 'unput' back
1363		- into the connection), and may be read in again. This is needed because carriage return
1364		- or line feed which are 'blank', also have a meaning in HTTP.
1365		-
1366		-define Result(Error,String)
1367		- read_word_aux
1368		- (
1369		- BufferedConnection connection,
1370		- Int dead_line,
1371		- List(Word8) so_far,
1372		- DenialOfService dos
1373		- ) =
1374		- if next_char(connection,dead_line,dos) is
1375		- {
1376		- error(msg) then error(msg),
1377		- ok(c) then
1378		- if is_blank(c)
1379		- then (unput(c);
1380		- ok(implode(reverse(so_far))))
1381		- else read_word_aux(connection,dead_line,[c . so_far],dos)
1382		- }.
1383		-
1384		-define Result(Error,String)
1385		- read_word
1386		- (
1387		- BufferedConnection connection,
1388		- Int dead_line,
1389		- DenialOfService dos
1390		- ) =
1391		- if skip_http_blanks(connection,dead_line,dos) is
1392		- {
1393		- error(msg) then error(msg),
1394		- ok(_) then
1395		- if next_char(connection,dead_line,dos) is
1396		- {
1397		- error(msg) then error(msg),
1398		- ok(c) then
1399		- if c = '\"'
1400		- then read_string(connection,dead_line,[],dos)
1401		- else read_word_aux(connection,dead_line,[c],dos)
1402		- }
1403		- }.
1404		-
1405		-
1406		-
1407		-
1408		-
1409		-
1410		-
1411		-
1412		- *** [4.4] Separating the URI from the query string.
1413		-
1414		- A 'query string' may be postfixed to the URI, just after a question mark. For example,
1415		- the client may send the following request:
1416		-
1417		- GET /catalog.awp?item=3&color=blue
1418		-
1419		- We separate this into an URI: "/catalog.awp" and the string: "item=3&color=blue" which
1420		- will be later transformed into the list:
1421		-
1422		- [web_arg("item","3"),web_arg("color","blue")]
1423		-
1424		-
1425		-define (String,String)
1426		- separate_uri_from_query_string
1427		- (
1428		- String uri_and_query_string,
1429		- Int n
1430		- ) =
1431		- if nth(n,uri_and_query_string) is
1432		- {
1433		- failure then (uri_and_query_string,""),
1434		- success(c) then
1435		- if c = '?'
1436		- then (substr(uri_and_query_string,0,n),
1437		- substr(uri_and_query_string,n+1,length(uri_and_query_string)-(n+1)))
1438		- else separate_uri_from_query_string(uri_and_query_string,n+1)
1439		- }.
1440		-
1441		-
1442		-
1443		-
1444		-
1445		-
1446		-
1447		-
1448		-
1449		- *** [4.5] Reading the web arguments.
1450		-
1451		- HTTP/HTTPS requests are sent in one of two formats:
1452		-
1453		- (1) www-url encoded
1454		- (2) multipart/form-data encoded
1455		-
1456		- The first one is the normal (historical) way of encoding. The second one is required
1457		- for uploading files. A server which is supposed to accept upload of files must handle
1458		- both formats. The first thing to do is to decide the format of the request. This is
1459		- easily done by examining the HTTP headers. If we find the header:
1460		-
1461		- Content-Type: multipart/form-data
1462		-
1463		- the request is multipart/form-data encoded. Otherwise, it is 'www-url' encoded. We
1464		- first consider 'www-url' encoded requests.
1465		-
1466		- For a 'www-url' encoded request, the web argument are either in the query string or in
1467		- the body of the request, or both. The format is the same for both:
1468		-
1469		- name=value&name=value&...
1470		-
1471		- However, we may also have
1472		-
1473		- name
1474		- name=
1475		- name=&...
1476		- name&...
1477		-
1478		- i.e. some parts may be missing. Hence, we must be careful.
1479		-
1480		- Furthermore, web arguments must be translated from web to ASCII when www-url encoded.
1481		-
1482		-define Bool
1483		- is_ampersand_or_equal
1484		- (
1485		- Word8 c
1486		- ) =
1487		- if c = '&' then true else c = '='.
1488		-
1489		-
1490		-
1491		- The function 'read_name_or_value' reads the string 's' starting at position 'n' until
1492		- either the end of the string or the first '&' or '='.
1493		-
1494		-define String
1495		- read_name_or_value
1496		- (
1497		- String s,
1498		- Int start,
1499		- Int i
1500		- ) =
1501		- if nth(i,s) is
1502		- {
1503		- failure then substr(s,start,i - start),
1504		- success(c) then
1505		- if is_ampersand_or_equal(c)
1506		- then substr(s,start,i-start) // the separator is not included
1507		- else read_name_or_value(s,start,i+1)
1508		- }.
1509		-
1510		-
1511		-define List(Web_arg)
1512		- read_www_url_encoded_web_args
1513		- (
1514		- String s,
1515		- Int start,
1516		- ) =
1517		- with first = read_name_or_value(s,start,start),
1518		- if first = ""
1519		- then []
1520		- else with i = start+length(first),
1521		- if nth(i,s) is
1522		- {
1523		- failure then [web_arg(first,"")],
1524		- success(c) then
1525		- if c = '&'
1526		- then [web_arg(first,"") . read_www_url_encoded_web_args(s,i+1)]
1527		- else if c = '='
1528		- then with second1 = read_name_or_value(s,i+1,i+1),
1529		- // print("\""+second1+"\"\n");
1530		- with second = web_to_ascii(second1,0,[]),
1531		- [web_arg(first,second) . read_www_url_encoded_web_args(s,i+length(second1)+2)]
1532		- else print("** ALERT ** badly formatted argument [" + s + "]!!!\n");
1533		- []
1534		- }.
1535		-
1536		-
1537		-
1538		-
1539		-
1540		- *** [4.7] Reading the request line.
1541		-
1542		- 'read_request_line' reads three words and a new line from the connection. It tries to
1543		- recognize "get" or "post" in the first word, separates the URI from the query string in
1544		- the second word, transforms the query string into a list of 'Web_arg', and finally
1545		- returns a datum of type 'HTTP_RequestLine' if no error arose.
1546		-
1547		-
1548		-define Result(Error,HTTP_RequestType)
1549		- identify_get_or_post
1550		- (
1551		- String s
1552		- ) =
1553		- with ls = to_lower(s),
1554		- if ls = "get" then ok(get) else
1555		- if ls = "post" then ok(post) else
1556		- error(not_get_or_post_request(ls)).
1557		-
1558		-define Result(Error,HTTP_RequestLine)
1559		- read_request_line
1560		- (
1561		- BufferedConnection connection,
1562		- Int dead_line,
1563		- DenialOfService dos
1564		- ) =
1565		- if read_word(connection,dead_line,dos) is
1566		- {
1567		- error(msg) then error(msg),
1568		- ok(get_or_post) then if read_word(connection,dead_line,dos) is
1569		- {
1570		- error(msg) then error(msg),
1571		- ok(uri_and_query_string) then if read_word(connection,dead_line,dos) is
1572		- {
1573		- error(msg) then error(msg),
1574		- ok(http_version) then if read_new_line(connection,dead_line,dos) is
1575		- {
1576		- error(msg) then error(msg),
1577		- ok(_) then if separate_uri_from_query_string(uri_and_query_string,0) is
1578		- (uri,query_string) then if identify_get_or_post(get_or_post) is
1579		- {
1580		- error(msg) then error(msg),
1581		- ok(request_type) then
1582		- ok(request_line(request_type, web_to_ascii(uri, 0, []), read_www_url_encoded_web_args(query_string,0)))
1583		- }
1584		- }
1585		- }
1586		- }
1587		- }.
1588		-
1589		-
1590		-
1591		-
1592		-
1593		-
1594		-
1595		- *** [4.8] Reading the HTTP headers.
1596		-
1597		- Each header is made of a name (containing only letters, the underscore, digits and the
1598		- minus sign), a colon, a value, and a new line. The first empty line ends the headers.
1599		-
1600		-
1601		- The next function tests characters acceptable in a header name.
1602		-
1603		-define Bool
1604		- is_header_name_char
1605		- (
1606		- Word8 c
1607		- ) =
1608		- if ('a' +=< c & c +=< 'z') then true else
1609		- if ('A' +=< c & c +=< 'Z') then true else
1610		- if ('0' +=< c & c +=< '9') then true else
1611		- if c = '-' then true else
1612		- c = '_'.
1613		-
1614		-define Result(Error,String)
1615		- read_header_name
1616		- (
1617		- BufferedConnection connection,
1618		- Int dead_line,
1619		- List(Word8) so_far,
1620		- DenialOfService dos
1621		- ) =
1622		- if next_char(connection,dead_line,dos) is
1623		- {
1624		- error(msg) then error(msg),
1625		- ok(c) then
1626		- if is_header_name_char(c)
1627		- then read_header_name(connection,dead_line,[to_lower(c) . so_far],dos)
1628		- else unput(c); ok(implode(reverse(so_far)))
1629		- }.
1630		-
1631		-define Result(Error,One)
1632		- skip_colon
1633		- (
1634		- BufferedConnection connection,
1635		- Int dead_line,
1636		- DenialOfService dos
1637		- ) =
1638		- if skip_http_blanks(connection,dead_line,dos) is
1639		- {
1640		- error(msg) then error(msg),
1641		- ok(_) then
1642		- if next_char(connection,dead_line,dos) is
1643		- {
1644		- error(msg) then error(msg),
1645		- ok(c) then
1646		- if c = ':'
1647		- then ok(unique)
1648		- else error(colon_expected)
1649		- }}.
1650		-
1651		-
1652		-define Result(Error,String)
1653		- read_header_value
1654		- (
1655		- BufferedConnection connection,
1656		- Int dead_line,
1657		- List(Word8) so_far,
1658		- DenialOfService dos
1659		- ) =
1660		- if next_char(connection,dead_line,dos) is
1661		- {
1662		- error(msg) then error(msg),
1663		- ok(c) then
1664		- if c = 13
1665		- then if next_char(connection,dead_line,dos) is
1666		- {
1667		- error(msg) then error(msg),
1668		- ok(d) then
1669		- if d = 10
1670		- then if next_char(connection,dead_line,dos) is
1671		- {
1672		- error(msg) then error(msg),
1673		- ok(e) then
1674		- if is_strict_blank(e)
1675		- then read_header_value(connection,dead_line,[e . so_far],dos)
1676		- else (unput(e); ok(implode(reverse(so_far))))
1677		- }
1678		- else read_header_value(connection,dead_line,[d, c . so_far],dos)
1679		- }
1680		- else read_header_value(connection,dead_line,[c . so_far],dos)
1681		- }.
1682		-
1683		-
1684		- Reading a single header.
1685		-
1686		-define Result(Error,Maybe(HTTP_header))
1687		- read_header
1688		- (
1689		- BufferedConnection connection,
1690		- Int dead_line,
1691		- DenialOfService dos
1692		- ) =
1693		- if read_header_name(connection,dead_line,[],dos) is
1694		- {
1695		- error(msg) then error(msg),
1696		- ok(name) then
1697		- if name = "" then
1698		- if read_and_ignore(connection,dead_line,2,dos) /* 13 and 10 */ is
1699		- {
1700		- error(msg) then error(msg),
1701		- ok(_) then // this is the blank line
1702		- ok(failure) // end of headers
1703		- }
1704		- else if skip_colon(connection,dead_line,dos) is
1705		- {
1706		- error(msg) then error(msg),
1707		- ok(_) then if skip_http_blanks(connection,dead_line,dos) is
1708		- {
1709		- error(msg) then error(msg),
1710		- ok(_) then if read_header_value(connection,dead_line,[],dos) is
1711		- {
1712		- error(msg) then error(msg),
1713		- ok(value) then
1714		- ok(success(http_header(name,value)))
1715		- }
1716		- }
1717		- }
1718		- }.
1719		-
1720		-
1721		-
1722		- Reading all the headers.
1723		-
1724		-define Result(Error,List(HTTP_header))
1725		- read_http_headers
1726		- (
1727		- BufferedConnection connection,
1728		- Int dead_line,
1729		- DenialOfService dos
1730		- ) =
1731		- if read_header(connection,dead_line,dos) is
1732		- {
1733		- error(msg) then error(msg),
1734		- ok(mbh) then if mbh is
1735		- {
1736		- failure then ok([ ]),
1737		- success(header) then
1738		- if read_http_headers(connection,dead_line,dos) is
1739		- {
1740		- error(msg) then error(msg),
1741		- ok(others) then ok([header . others])
1742		- }
1743		- }
1744		- }.
1745		-
1746		-
1747		-
1748		-
1749		-
1750		-
1751		-
1752		- *** [4.9] Getting the size of the request's body.
1753		-
1754		- The size of the body of the request is given under the 'Content-Length' header. If this
1755		- header is not present, the size is assumed to be zero.
1756		-
1757		-define Result(Error,Int)
1758		- get_body_size
1759		- (
1760		- List(HTTP_header) headers
1761		- ) =
1762		- if headers is
1763		- {
1764		- [ ] then ok(0),
1765		- [h . t] then if h is http_header(name,value) then
1766		- if name = "content-length"
1767		- then if decimal_scan(value) is
1768		- {
1769		- failure then error(incorrect_content_length_value),
1770		- success(n) then ok(n)
1771		- }
1772		- else get_body_size(t)
1773		- }.
1774		-
1775		-
1776		-
1777		-
1778		-
1779		-
1780		-
1781		-
1782		-
1783		-
1784		- *** [4.10] Reading the body of the request.
1785		-
1786		- The body of the request may be very big (it contains uploaded files, if any). We read
1787		- it using the primitive 'read', which returns the number of bytes read, which may be
1788		- less than the number of bytes we wanted to read. This is not an error, but simply due
1789		- to the fact the buffer associated with the connection in the Linux (or MS-Windows)
1790		- kernel has a limited size. Hence, we must read bytes again until we have read the
1791		- required number of bytes. However, if the number of bytes read is zero, the connection
1792		- may be broken. In that case, we must not try to read indefinitely. On the contrary, we
1793		- make at most 10 retries, with a small sleeping time between any two of them.
1794		-
1795		-define Result(Error,ByteArray)
1796		- read_http_body
1797		- (
1798		- BufferedConnection connection,
1799		- Int body_size,
1800		- ByteArray so_far, // when calling this function, 'so_far' is the empty byte array
1801		- Int retries // this function is called with retries = 10
1802		- ) =
1803		- if body_size = 0 then ok(constant_byte_array(0,0)) else
1804		- if retries =< 0 then error(cannot_read_from_connection) else
1805		- if read_from_connexion(connection,body_size,60,constant_byte_array(body_size,0),0) is
1806		- {
1807		- error then error(cannot_read_from_connection),
1808		- timeout then error(timeout(60)),
1809		- ok(new_bytes) then with
1810		- ba = so_far + new_bytes, // contains all the bytes read so far
1811		- nr = length(ba), // total read since the beginning
1812		- nn = length(new_bytes), // number of bytes just read
1813		- if nr < body_size // must read more bytes
1814		- then if nn > 0 // if connection seems to work
1815		- then read_http_body(connection,body_size,ba,1000) // continue reading
1816		- else sleep(100); // otherwise, sleep 1/10 of second
1817		- read_http_body(connection,body_size,ba, // and retry reading
1818		- retries-1) // but no more than 10 times
1819		- else ok(ba) // required number of bytes has been read
1820		- }.
1821		-
1822		-
1823		- Note: During sleeping, 'anbexec' runs other machines. Actually, calling 'sleep', even
1824		- for one millisecond, is some way of giving up explicitly, so that other virtual
1825		- machines may work.
1826		-
1827		-
1828		-
1829		-
1830		-
1831		-
1832		-
1833		-
1834		-
1835		-
1836		-
1837		-
1838		- *** [5] Making the HTTP answer.
1839		-
1840		- At that point we have read the request line, the headers and the body of the
1841		- request, and we must decide what to do.
1842		-
1843		- Actually, we can do one of the following:
1844		-
1845		- - send a file,
1846		- - execute 'tickets_and_web_page' in case of an ".awp" URI.
1847		-
1848		- The uploaded file (which are in the body of the request) are saved into temporary files
1849		- below.
1850		-
1851		-
1852		-
1853		-
1854		-
1855		- *** [5.1] Avoiding illegal URIs.
1856		-
1857		- For security reasons, we must avoid illegal URIs, for example those which may climb up
1858		- in the file hierarchy. First we accept only few characters in URIs.
1859		-
1860		-define Bool
1861		- is_legal_uri_char
1862		- (
1863		- Word8 c
1864		- ) =
1865		- if ('a' +=< c & c +=< 'z') then true else // accept 'a' to 'z'
1866		- if ('A' +=< c & c +=< 'Z') then true else // accept 'A' to 'Z'
1867		- if ('0' +=< c & c +=< '9') then true else // accept '0' to '9'
1868		- if c = '.' then true else // accept '.' '-' '/' and '_'
1869		- if c = '-' then true else
1870		- if c = '/' then true else
1871		- c = '_'.
1872		-
1873		- We do not accept ~ which is some way of climbing. Of course, we cannot disallow single
1874		- dots, which are most often present in legal URIs, but we must avoid double dots ..
1875		- which mean 'climb up'.
1876		-
1877		-define Bool
1878		- is_illegal_uri
1879		- (
1880		- String uri,
1881		- Int n
1882		- ) =
1883		- if nth(n,uri) is
1884		- {
1885		- failure then false,
1886		- success(c) then
1887		- if c = '.' // first dot
1888		- then if nth(n+1,uri) is
1889		- {
1890		- failure then false,
1891		- success(d) then
1892		- if d = '.' // second dot
1893		- then true
1894		- else is_illegal_uri(uri,n+1)
1895		- }
1896		- else is_illegal_uri(uri,n+1)
1897		- }.
1898		-
1899		-
1900		-
1901		-
1902		-
1903		-
1904		- *** [5.2] Managing authorizations for downloading private files.
1905		-
1906		- Computing the authorization and making the authorization file (containing the absolute
1907		- path of the file on the server).
1908		-
1909		-
1910		-define String
1911		- compute_authorization
1912		- (
1913		- String authorization_secret,
1914		- String absolute_path
1915		- ) =
1916		- to_ascii(sha1((authorization_secret,
1917		- absolute_path))).
1918		-
1919		-
1920		-public define String
1921		- make_authorization
1922		- (
1923		- String site_directory,
1924		- String authorization_secret,
1925		- String absolute_path
1926		- ) =
1927		- with private_download_dir = site_directory+"/private_download",
1928		- auth = compute_authorization(authorization_secret,
1929		- absolute_path),
1930		- forget(save(absolute_path,
1931		- private_download_dir+"/z"+auth));
1932		- auth.
1933		-
1934		-
1935		- The function 'send_file' defined below handles the recognition of authorizations.
1936		-
1937		-
1938		-
1939		-
1940		-
1941		- *** [5.3] Recognizing MIME types.
1942		-
1943		- The extension of the (redirected) URI must be either ".awp" or recognized as associated
1944		- to a MIME type. Otherwise, the server will not send the file. This is for security, but
1945		- also because, we must generate a 'Content-Type' header in the answer, with the right
1946		- MIME type.
1947		-
1948		-define String
1949		- get_uri_extension_aux
1950		- (
1951		- String uri,
1952		- Int n // used for searching backwards
1953		- ) =
1954		- if nth(n,uri) is
1955		- {
1956		- failure then "",
1957		- success(c) then
1958		- if c = '.' then substr(uri,n,length(uri)-n)
1959		- else if c = '/' then ""
1960		- else get_uri_extension_aux(uri,n-1)
1961		- }.
1962		-
1963		-public define String
1964		- get_uri_extension
1965		- (
1966		- String uri
1967		- ) =
1968		- get_uri_extension_aux(uri,
1969		- length(uri)-1). // search starts at the right end
1970		-
1971		-public define Bool
1972		- contains_no_case
1973		- (
1974		- List(String) l,
1975		- String val
1976		- ) =
1977		- if l is
1978		- {
1979		- [] then false,
1980		- [h . t] then
1981		- if insensitive_equal(h, val) then true
1982		- else contains_no_case(t, val)
1983		- }.
1984		-
1985		-
1986		-define Maybe(MIME)
1987		- recognize_mime_type_from_ext
1988		- (
1989		- String ext,
1990		- List(MIME) l
1991		- ) =
1992		- if l is
1993		- {
1994		- [ ] then success(mime("application", "octet-stream", [])), // failure,
1995		- [h . t] then if h is mime(type, subtype, extensions) then
1996		- if contains_no_case(extensions, ext)
1997		- then success(h)
1998		- else recognize_mime_type_from_ext(ext,t)
1999		- }.
2000		-
2001		-define Maybe(MIME)
2002		- recognize_mime_type_from_uri
2003		- (
2004		- Web_Site_Description desc,
2005		- String uri
2006		- ) =
2007		- recognize_mime_type_from_ext(get_uri_extension(uri),known_mime_types(desc)).
2008		-
2009		-
2010		-
2011		-
2012		-
2013		-
2014		-
2015		-
2016		- *** [5.4] Formating HTTP headers.
2017		-
2018		- This is the formating for sending to the client (hence, it has nothing to do with the
2019		- component 'journal_headers' in the web site description).
2020		-
2021		-public define Printable_tree
2022		- format_headers
2023		- (
2024		- List(HTTP_header) headers
2025		- ) =
2026		- if headers is
2027		- {
2028		- [ ] then [ ],
2029		- [h . t] then if h is http_header(name,value) then
2030		- [name,": ",value,crlf . format_headers(t)]
2031		- }.
2032		-
2033		-
2034		-
2035		-define String
2036		- month_abrv
2037		- (
2038		- Date_and_Time d
2039		- ) =
2040		- if d.month = 1 then "Jan"
2041		- else if d.month = 2 then "Feb"
2042		- else if d.month = 3 then "Mar"
2043		- else if d.month = 4 then "Apr"
2044		- else if d.month = 5 then "May"
2045		- else if d.month = 6 then "Jun"
2046		- else if d.month = 7 then "Jul"
2047		- else if d.month = 8 then "Aug"
2048		- else if d.month = 9 then "Sep"
2049		- else if d.month = 10 then "Oct"
2050		- else if d.month = 11 then "Nov"
2051		- else if d.month = 12 then "Dec"
2052		- else
2053		- println("Bad month value [" + d.month + "] on Date_and_Time");
2054		- "XXX".
2055		-
2056		-define String
2057		- weekday_abrv
2058		- (
2059		- Date_and_Time d
2060		- ) =
2061		- if d.week_day = 0 then "Sun"
2062		- else if d.week_day = 1 then "Mon"
2063		- else if d.week_day = 2 then "Tue"
2064		- else if d.week_day = 3 then "Wed"
2065		- else if d.week_day = 4 then "Thu"
2066		- else if d.week_day = 5 then "Fri"
2067		- else if d.week_day = 6 then "Sat"
2068		- else
2069		- println("Bad weekday value [" + d.week_day + "] on Date_and_Time");
2070		- "XXX".
2071		-
2072		-/**
2073		- * Format a date with the followin format : "Mon, 23 Jul 2007 11:33:43 GMT"
2074		- * Currently, this function can't output a GMT time, but only local time.
2075		- * So the final GMT is totally fake, but needed by protocol.
2076		- */
2077		-public define String
2078		- format_http_date
2079		- (
2080		- Date_and_Time d
2081		- ) =
2082		- weekday_abrv(d) + ", " + zero_pad_n(2,day(d)) + " " + month_abrv(d) + " " + year(d)
2083		- + " " + zero_pad_n(2,hour(d)) + ":" + zero_pad_n(2,minute(d)) + ":" + zero_pad_n(2,second(d)) + " GMT".
2084		-
2085		-/**
2086		- * Same as previous format_http_date() function, but with seconds count from the UNIX epoch as input.
2087		- */
2088		-public define String
2089		- format_http_date
2090		- (
2091		- Int date
2092		- ) =
2093		- format_http_date(convert_time(date)).
2094		-
2095		-
2096		- *** [5.5] Sending a file.
2097		-
2098		- We send 2 headers 'Content-Type' and 'Content-Length'.
2099		-
2100		-define List(HTTP_header)
2101		- headers_for_send_file
2102		- (
2103		- MIME mime_type,
2104		- Int size,
2105		- String etag,
2106		- Maybe(FileTimes) mb_ftimes,
2107		- ) =
2108		- with headers = (List(HTTP_header))
2109		- [
2110		- http_header("Content-Type", to_String(mime_type)),
2111		- http_header("Etag", etag),
2112		- http_header("Content-Length",to_decimal(size)),
2113		- ],
2114		- if mb_ftimes is
2115		- {
2116		- failure then headers,
2117		- success(ftimes) then [http_header("Last-Modified", format_http_date(to_Int(ftimes.last_modified))) . headers]
2118		- }
2119		- .
2120		-
2121		-
2122		-
2123		- Sending the body of the answer (i.e. the file itself).
2124		-
2125		-define One
2126		- send_file_body
2127		- (
2128		- Web_Site_Description desc,
2129		- Connection connection, // connection with the client
2130		- Connection file, // file to be sent already opened
2131		- Int size, // size of file
2132		- Int sent, // bytes already sent
2133		- String filename // name of file
2134		- ) =
2135		- if sent >= size then unique else
2136		- if read(file,min(16384,size-sent),60) is
2137		- {
2138		- error then log_journal_msg(desc,"Cannot read from file '"+filename+"'.\n"),
2139		- timeout then log_journal_msg(desc,"Cannot read from file timeoput'"+filename+"'.\n"),
2140		- ok(ba) then
2141		- with nr = length(ba), // get the number of bytes read
2142		- if reliable_write(connection, ba) is
2143		- {
2144		- failure then log_journal_msg(desc,"Cannot write into connection delirering '"+filename+"' (sent="+sent+"; size="+size+"; current="+nr+").\n"),
2145		- success(nw) then
2146		- send_file_body(desc,connection,file,size,sent+nw,filename)
2147		- }
2148		- }.
2149		-
2150		-
2151		-define String
2152		- compute_etag
2153		- (
2154		- String filename,
2155		- Maybe(FileTimes) mb_ftimes,
2156		- Int size,
2157		- ) =
2158		- if mb_ftimes is
2159		- {
2160		- failure then println("Warning: no file times for '" + filename + "', etag won't be very accurate."); to_ascii(sha1((filename, size))),
2161		- success(ftimes) then to_ascii(md5((filename, ftimes, size)))
2162		- }.
2163		-
2164		-define Bool
2165		- are_same_etag
2166		- (
2167		- Maybe(String) input_etag,
2168		- String current_etag
2169		- ) =
2170		- if input_etag is
2171		- {
2172		- failure then false,
2173		- success(etag) then etag = current_etag
2174		- }.
2175		-
2176		- Sending the answer line, the headers and the body.
2177		-
2178		-define One
2179		- send_file
2180		- (
2181		- Web_Site_Description desc,
2182		- Connection connection,
2183		- List(HTTP_header) input_headers,
2184		- List(HTTP_header) headers,
2185		- Int size,
2186		- Connection file,
2187		- String filename,
2188		- String full_path,
2189		- MIME mime_type,
2190		- One -> One action_before_send_file
2191		- ) =
2192		- action_before_send_file(unique);
2193		- with input_etag = http_header_value(input_headers, "If-None-Match"),
2194		- mb_ftimes = get_file_times(full_path),
2195		- current_etag = compute_etag(full_path, mb_ftimes, size),
2196		- if are_same_etag(input_etag, current_etag) is
2197		- {
2198		- false then
2199		- forget(reliable_write(connection,to_byte_array("HTTP/1.1 200 OK"+crlf)));
2200		- forget(reliable_write(connection,[format_headers(headers + headers_for_send_file(mime_type, size, current_etag, mb_ftimes)) , crlf]));
2201		- //forget(copy_file_to_Connection(file, connection, size)),
2202		- send_file_body(desc,connection,file,size,0,filename),
2203		- true then
2204		- forget(reliable_write(connection,to_byte_array("HTTP/1.1 304 Not Modified"+crlf)));
2205		- forget(reliable_write(connection,[format_headers([http_header("Etag", current_etag) . headers]) , crlf]))
2206		- //send_file_body(desc,connection,file,size,0,filename)
2207		- }.
2208		-
2209		-
2210		-
2211		- Checking if a connection is under SSL.
2212		-
2213		-define Bool
2214		- is_SSL
2215		- (
2216		- Connection c
2217		- ) =
2218		- if c is
2219		- {
2220		- file_r(_) then false,
2221		- file_w(_) then false,
2222		- file_rw(_) then false,
2223		- tcp(_) then false,
2224		- ssl(_) then true
2225		- }.
2226		-
2227		-
2228		-
2229		- Before opening and sending a file, we check the MIME type. It must be recognized,
2230		- except if there is a valid authorization for private download.
2231		-
2232		-define One
2233		- send_file
2234		- (
2235		- Web_Site_Description desc,
2236		- Connection connection,
2237		- String uri,
2238		- List(HTTP_header) input_headers,
2239		- List(HTTP_header) output_headers,
2240		- Maybe(String) mbauthorization,
2241		- One -> One action_before_send_file
2242		- ) =
2243		- if mbauthorization is
2244		- {
2245		- //--- file without authorization: take it from public ---
2246		- failure then if recognize_mime_type_from_uri(desc,uri) is
2247		- {
2248		- failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"),
2249		- success(mime_type) then
2250		- with path = site_directory(desc)+"/public"+uri,
2251		- if (Maybe(RStream))file(path, read) is
2252		- {
2253		- failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"),
2254		- success(f) then with size = file_size(f),
2255		- send_file(desc,
2256		- connection,
2257		- input_headers,
2258		- output_headers,
2259		- size,
2260		- file(f),
2261		- uri,
2262		- path,
2263		- mime_type,
2264		- action_before_send_file)
2265		- }
2266		- },
2267		-
2268		- //--- file with authorization: apply 'private download' mecanism ---
2269		- success(authorization) then
2270		- with private_download_dir = site_directory(desc)+"/private_download",
2271		- if (RetrieveResult(String))retrieve(private_download_dir+"/z"+authorization)
2272		- is ok(absolute_path)
2273		- then (
2274		- with new_hash = compute_authorization(authorization_secret(desc),
2275		- absolute_path),
2276		- if (Maybe(RStream))connect to file absolute_path is
2277		- {
2278		- failure then log_journal_msg(desc,"Cannot find file '"+absolute_path+"'.\n"),
2279		- success(f) then with size = file_size(f),
2280		- mime_type = if recognize_mime_type_from_uri(desc,uri) is
2281		- {
2282		- failure then mime("application", "octet-stream", []),
2283		- success(mime_type) then mime_type
2284		- },
2285		- send_file(desc,
2286		- connection,
2287		- input_headers,
2288		- output_headers,
2289		- size,
2290		- file(f),
2291		- uri,
2292		- absolute_path,
2293		- mime_type,
2294		- action_before_send_file)
2295		- }
2296		- )
2297		- else log_journal_msg(desc,"Cannot find or read authorization file.\n")
2298		- }.
2299		-
2300		-
2301		-
2302		-
2303		-
2304		-
2305		-
2306		-
2307		- *** [5.6] Answering a www-url encoded request.
2308		-
2309		- Standard headers are for answering ".awp" requests.
2310		-
2311		-public define List(HTTP_header)
2312		- standard_headers
2313		- =
2314		- [
2315		- http_header("Date", format_http_date(now)),
2316		- http_header("Server", "Anubis Embedded Server v" + major_version_number + "." + minor_version_number),
2317		- http_header("Connection", "close"),
2318		- ].
2319		-
2320		-public define List(HTTP_header)
2321		- standard_headers_for
2322		- (
2323		- String mime_type,
2324		- Int answer_body_size,
2325		- Maybe(String) mb_charset,
2326		- ) =
2327		- [
2328		- http_header("Content-Type", mime_type + if mb_charset is success(charset) then "; charset="+charset else ""),
2329		- http_header("Content-length", to_decimal(answer_body_size))
2330		- ].
2331		-
2332		-public define List(HTTP_header)
2333		- file_attached_header
2334		- (
2335		- String filename
2336		- ) =
2337		- [
2338		- http_header("Content-Disposition", "attachment; filename=\"" + filename +"\"")
2339		- ].
2340		-
2341		-
2342		-define One
2343		- www_url_answer
2344		- (
2345		- String host_name,
2346		- Web_Site_Description desc,
2347		- Connection connection, // with the client
2348		- Word32 ip_addr, // of the client
2349		- HTTP_RequestLine request_line,
2350		- List(HTTP_header) headers,
2351		- ByteArray body,
2352		- One -> String generate_tt // trust ticket generation
2353		- ) =
2354		- with all_web_args = query_string(request_line) +
2355		- read_www_url_encoded_web_args(to_string(body),0),
2356		- uri = uri(request_line),
2357		- ext = get_uri_extension(uri),
2358		- http_inf = http_info(ip_addr, host_name, uri, headers, is_SSL(connection), generate_tt),
2359		- (if member(journal_extensions(desc),ext)
2360		- then log_journal_msg(desc,
2361		- format_request(desc,connection,request_line,headers,all_web_args))
2362		- else unique);
2363		- if is_illegal_uri(uri,0)
2364		- then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
2365		- else (if (ext = ".awp" \| ext = "")
2366		- then (with answer_headers_body = awp_handler(desc)(host_name,
2367		- http_inf,
2368		- all_web_args,
2369		- is_SSL(connection)),
2370		- //print_delta("After page generation");
2371		- forget(reliable_write(connection, answer_headers_body))
2372		- //print_delta("After sending page")
2373		- )
2374		- else (send_file(desc,
2375		- connection,
2376		- uri,
2377		- headers,
2378		- standard_headers,
2379		- if web_arg_value(all_web_args,"zauth") is
2380		- {
2381		- not_found then failure,
2382		- found(v) then success(v)
2383		- },
2384		- (One u) \|-> before_send_file(desc)(http_inf, all_web_args))
2385		- //print_delta("After sending file")
2386		- )).
2387		-
2388		-
2389		-
2390		-
2391		-
2392		-
2393		-
2394		- *** [5.7] Answering a multipart/form-data encoded request.
2395		-
2396		- In order to support upload of files, we must be able to read web arguments which are
2397		- encoded in a multipart/form-data body. The first thing to do is to find the
2398		- boundary. The boundary is a special string which delimits the various parts of the
2399		- 'multipart' body. It is found within the value of the 'Content-Type' HTTP header, as
2400		- the value of the 'boundary' attribute.
2401		-
2402		-
2403		-
2404		-
2405		-
2406		- *** [5.7.1] Finding the boundary.
2407		-
2408		- Hence, we just have to find the string 'boundary=' within the value of the
2409		- 'Content-Type' header, and read the value of the boundary from there.
2410		-
2411		-define Bool
2412		- delimits_boundary
2413		- (
2414		- Word8 c
2415		- ) =
2416		- if c = ' ' then true else
2417		- if c = 13 then true else
2418		- if c = 10 then true else
2419		- if c = 0 then true else
2420		- if c = ',' then true else
2421		- c = ';'.
2422		-
2423		-
2424		-define Maybe(String)
2425		- get_boundary_value_3
2426		- (
2427		- String s,
2428		- Int i,
2429		- List(Word8) so_far
2430		- ) =
2431		- if nth(i,s) is
2432		- {
2433		- failure then success(implode(reverse(so_far))),
2434		- success(c) then
2435		- if delimits_boundary(c)
2436		- then success(implode(reverse(so_far)))
2437		- else get_boundary_value_3(s,i+1,[c . so_far])
2438		- }.
2439		-
2440		-
2441		-
2442		-define Maybe(String)
2443		- get_boundary_value_2
2444		- (
2445		- String s,
2446		- Int i,
2447		- ) =
2448		- if nth(i,s) is
2449		- {
2450		- failure then failure,
2451		- success(c) then
2452		- if is_blank(c)
2453		- then get_boundary_value_2(s,i+1)
2454		- else get_boundary_value_3(s,i+1,[c])
2455		- }.
2456		-
2457		-define Maybe(String)
2458		- get_boundary_value_1
2459		- (
2460		- String s, // string into which we must find '= ...'
2461		- Int i // position of start of search
2462		- ) =
2463		- if nth(i,s) is
2464		- {
2465		- failure then failure,
2466		- success(c) then
2467		- if is_blank(c)
2468		- then get_boundary_value_1(s,i+1)
2469		- else if c = '='
2470		- then get_boundary_value_2(s,i+1)
2471		- else failure
2472		- }.
2473		-
2474		-
2475		-define Maybe(String)
2476		- get_boundary
2477		- (
2478		- String content_type_header_value
2479		- ) =
2480		- if find("boundary",content_type_header_value,0) is
2481		- {
2482		- failure then failure,
2483		- success(n) then // 'boundary' has been found at position n
2484		- get_boundary_value_1(content_type_header_value,n+8)
2485		- }.
2486		-
2487		-define Maybe(String)
2488		- get_boundary
2489		- (
2490		- List(HTTP_header) headers
2491		- ) =
2492		- if headers is
2493		- {
2494		- [ ] then failure,
2495		- [h . t] then if h is http_header(name,value) then
2496		- if name = "content-type"
2497		- then get_boundary(value)
2498		- else get_boundary(t)
2499		- }.
2500		-
2501		-
2502		-
2503		-
2504		-
2505		-
2506		-
2507		-
2508		- *** [5.7.2] Reading attributes from a multipart entity.
2509		-
2510		- Entities in a multipart/form-data body are separated by instances of the string:
2511		-
2512		- --bbbbb
2513		-
2514		- where bbbbb is the boundary computed above. Actually, the body has the form:
2515		-
2516		- --bbbbb
2517		- <entity 1>
2518		- --bbbbb
2519		- <entity 2>
2520		- --bbbbb
2521		- ...
2522		- --bbbbb
2523		- <last entity>
2524		- --bbbbb
2525		-
2526		-
2527		- We have to extract an entity which is in the body between offsets 'start' and 'end'
2528		- (computed when boundaries have been localized). The entity itself is made of two parts:
2529		- headers and body. The body is separated from the headers by a blank line. This blank
2530		- line (a double crlf) marks the beginning of the body of the entity. Within the headers
2531		- of the entity, we look for a 'Content-Disposition' header, which should look like this:
2532		-
2533		- Content-Disposition: form-data; name="..."; filename="..." crlf
2534		-
2535		- We are just interested in the name and the file name. Hence we first search
2536		- 'Content-Disposition', then we search 'name' and read the value, and we do the same for
2537		- 'filename'.
2538		-
2539		- If the 'filename' attribute is not present, the web arg is an ordinary one, otherwise,
2540		- it is an uploaded file.
2541		-
2542		-
2543		- Below is a variant of 'find' (see 'tools/findstring.anubis'), with an extra 'end'
2544		- argument.
2545		-
2546		-define Maybe(Int)
2547		- find
2548		- (
2549		- String what,
2550		- ByteArray where,
2551		- Int start,
2552		- Int end
2553		- ) =
2554		- if find(to_byte_array(what),where,start) is
2555		- {
2556		- failure then failure,
2557		- success(n) then
2558		- if n+length(what) >= end
2559		- then failure
2560		- else success(n)
2561		- }.
2562		-
2563		-
2564		-define String
2565		- read_attribute_value
2566		- (
2567		- ByteArray where,
2568		- Int start,
2569		- Int end,
2570		- List(Word8) so_far
2571		- ) =
2572		- if start >= end then implode(reverse(so_far)) else
2573		- if nth(start,where) is
2574		- {
2575		- failure then implode(reverse(so_far)),
2576		- success(c) then
2577		- if c = '\"'
2578		- then implode(reverse(so_far))
2579		- else read_attribute_value(where,start+1,end,[c . so_far])
2580		- }.
2581		-
2582		-define Maybe(String)
2583		- find_attribute
2584		- (
2585		- String name,
2586		- ByteArray where,
2587		- Int start,
2588		- Int end
2589		- ) =
2590		- with prefix = name+"=\"",
2591		- if find(to_byte_array(prefix),where,start) is
2592		- {
2593		- failure then failure,
2594		- success(n) then
2595		- if n+length(prefix) >= end
2596		- then failure
2597		- else success(read_attribute_value(where,n+length(prefix),end,[]))
2598		- }.
2599		-
2600		-
2601		-
2602		-define Maybe((String,Maybe(String)))
2603		- find_name_and_filename
2604		- (
2605		- ByteArray body,
2606		- Int start,
2607		- Int end
2608		- ) =
2609		- if find(to_byte_array("Content-Disposition"),body,start) is
2610		- {
2611		- failure then failure,
2612		- success(n) then
2613		- if find_attribute("name",body,n+19,end) is
2614		- {
2615		- failure then failure,
2616		- success(name_value) then if find_attribute("filename",body,n+19,end) is
2617		- {
2618		- failure then success((name_value,failure)),
2619		- success(filename_value) then success((name_value,success(filename_value)))
2620		- }
2621		- }
2622		- }.
2623		-
2624		-
2625		-
2626		-
2627		-
2628		-
2629		-
2630		-
2631		-
2632		-
2633		- *** [5.7.3] Creating a temporary filename for an uploaded file.
2634		-
2635		-variable Int uploaded_file_count = 0.
2636		-
2637		- This variable is local to the virtual machine. Hence, its value is 0 each time a new
2638		- requests arrives. Temporary uploaded files are stored in the directory represented by
2639		- 'upload_temporary_directory'. The filenames have the form:
2640		-
2641		- _m_n
2642		-
2643		- where 'm' is the number of the virtual machine, and 'n' a number obtained by
2644		- incrementing 'uploaded_file_count'. Notice that the program must do something with this
2645		- file (move it to some directory/name), otherwise, it will probably be overwritten the
2646		- next time the same machine works.
2647		-
2648		-
2649		-
2650		-
2651		-
2652		-
2653		- *** [5.7.4] Saving an uploaded file under a temporary filename.
2654		-
2655		-define Maybe(String) // returns the temporary file name
2656		- save_uploaded_file
2657		- (
2658		- Web_Site_Description desc,
2659		- ByteArray body,
2660		- Int start,
2661		- Int end
2662		- ) =
2663		- uploaded_file_count <- 1 + *uploaded_file_count;
2664		- with tfn = "_"+to_decimal(virtual_machine_id)+"_"+to_decimal(*uploaded_file_count),
2665		- if (Maybe(WStream))connect to file site_directory(desc)+"/upload_temporary/"+tfn is
2666		- {
2667		- failure then failure,
2668		- success(f) then
2669		- if reliable_write(file(f),extract(body,start,end)) is
2670		- {
2671		- failure then failure,
2672		- success(nw) then
2673		- if nw = end - start
2674		- then success(tfn)
2675		- else failure
2676		- }
2677		- }.
2678		-
2679		-
2680		-
2681		-
2682		-
2683		-
2684		-
2685		-
2686		- *** [5.7.5] Removing the path from a file name.
2687		-
2688		- When a file is uploaded, the browser sends the complete path of the file on the client
2689		- machine as the file name. Actually, this is not quite normal. Nevertheless, we need to
2690		- remove the path, and keep only the file name. This is achieved by 'remove_path' below.
2691		-
2692		-define Int
2693		- file_name_begin
2694		- (
2695		- String full_name,
2696		- Int i
2697		- ) =
2698		- if nth(i,full_name) is
2699		- {
2700		- failure then 0,
2701		- success(c) then
2702		- if c = '/' then i+1 else
2703		- if c = '\\' then i+1 else
2704		- file_name_begin(full_name,i-1)
2705		- }.
2706		-
2707		-define String
2708		- remove_path
2709		- (
2710		- String full_name
2711		- ) =
2712		- with l = length(full_name),
2713		- b = file_name_begin(full_name,l-1),
2714		- substr(full_name,b,l-b).
2715		-
2716		-
2717		-
2718		-
2719		-
2720		- *** [5.7.6] Reading a multipart entity.
2721		-
2722		-define Maybe(Web_arg)
2723		- get_multipart_entity
2724		- (
2725		- Web_Site_Description desc,
2726		- ByteArray body,
2727		- Int start,
2728		- Int end
2729		- ) =
2730		- if find(to_byte_array(crlf+crlf),body,start) is
2731		- {
2732		- failure then failure,
2733		- success(k) then
2734		- if k >= end // must be within this entity, not the next one
2735		- then failure
2736		- else if find_name_and_filename(body,start,k) is
2737		- {
2738		- failure then failure,
2739		- success(n_mbfn) then if n_mbfn is (name,mbfn) then
2740		- if mbfn is
2741		- {
2742		- failure then
2743		- success(web_arg(name,to_string(extract(body,k+4,end-2)))),
2744		- // we must substract 2 to end because of crlf just before the boundary
2745		-
2746		- success(fn) then
2747		- if save_uploaded_file(desc,body,k+4,end-2) is
2748		- {
2749		- failure then failure,
2750		- success(tfn) then
2751		- success(upload(name,remove_path(fn),
2752		- site_directory(desc)+"/upload_temporary/"+tfn))
2753		-
2754		- }
2755		- }
2756		- }
2757		- }.
2758		-
2759		-
2760		-
2761		-define List(Web_arg)
2762		- read_multipart_form_data_encoded_web_args
2763		- (
2764		- Web_Site_Description desc,
2765		- ByteArray body,
2766		- ByteArray __boundary,
2767		- Int i,
2768		- ) =
2769		- if find(__boundary,body,i) is
2770		- {
2771		- failure then [ ],
2772		- success(n) then
2773		- if find(__boundary,body,n+length(__boundary)) is
2774		- {
2775		- failure then [ ],
2776		- success(m) then
2777		- if get_multipart_entity(desc,body,n+length(__boundary),m) is
2778		- {
2779		- failure then [ ],
2780		- success(wa) then
2781		- [wa . read_multipart_form_data_encoded_web_args(desc,body,__boundary,m)]
2782		- }
2783		- }
2784		- }.
2785		-
2786		-
2787		-
2788		-define One
2789		- multipart_form_data_answer
2790		- (
2791		- String host_name,
2792		- Web_Site_Description desc,
2793		- Connection connection,
2794		- Word32 ip_addr,
2795		- HTTP_RequestLine request_line,
2796		- List(HTTP_header) headers,
2797		- ByteArray body,
2798		- One -> String generate_tt
2799		- ) =
2800		- if get_boundary(headers) is
2801		- {
2802		- failure then unique,
2803		- success(boundary) then
2804		- with all_web_args = query_string(request_line) +
2805		- read_multipart_form_data_encoded_web_args(desc,
2806		- body,
2807		- to_byte_array("--"+boundary),
2808		- 0),
2809		- uri = uri(request_line),
2810		- ext = get_uri_extension(uri),
2811		- log_journal_msg(desc,
2812		- format_request(desc,connection,request_line,headers,all_web_args));
2813		- if is_illegal_uri(uri,0)
2814		- then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
2815		- else
2816		- if (ext = ".awp" \| ext = "") then
2817		- (with answer_headers_body = awp_handler(desc)(host_name,
2818		- http_info(ip_addr, host_name, uri, headers, is_SSL(connection), generate_tt),
2819		- all_web_args,
2820		- is_SSL(connection)),
2821		- forget(reliable_write(connection, answer_headers_body)))
2822		- else unique
2823		- }.
2824		-
2825		-
2826		-
2827		-
2828		-
2829		-
2830		-
2831		-
2832		- *** [5.8] Handling redirections.
2833		-
2834		- 'redirections' (of type 'List(Redirection)') contains redirection directives. Each one
2835		- has the form:
2836		-
2837		- redirect(required_uri,required_host,corresponding_uri).
2838		-
2839		- The host required by the client may be found in the 'Host' HTTP header. The URI
2840		- required by the client is given below as 'uri'. We just have to find the required host
2841		- in the headers, and to find the corresponding redirection directive.
2842		-
2843		-
2844		- In the next fonction, the required host and URI are known. We just have to search in
2845		- the 'redirections' list.
2846		-
2847		-define String
2848		- handle_redirection
2849		- (
2850		- String required_uri,
2851		- String required_host,
2852		- List(Redirection) redirections
2853		- ) =
2854		- if redirections is
2855		- {
2856		- [ ] then required_uri,
2857		- [h . t] then if h is redirect(uri,host,target) then
2858		- if host = required_host
2859		- then if uri = required_uri
2860		- then target
2861		- else handle_redirection(required_uri,required_host,t)
2862		- else handle_redirection(required_uri,required_host,t)
2863		- }.
2864		-
2865		-
2866		-
2867		- The host name may be encumbered by a port number, like
2868		-
2869		- www.our-business.com:1607
2870		-
2871		- We must remove this port number, otherwise the host name may not be recognized.
2872		-
2873		-define String
2874		- strip_port
2875		- (
2876		- String name,
2877		- Int i
2878		- ) =
2879		- if nth(i,name) is
2880		- {
2881		- failure then name,
2882		- success(c) then
2883		- if c = ':'
2884		- then substr(name,0,i)
2885		- else strip_port(name,i+1)
2886		- }.
2887		-
2888		-
2889		-
2890		-
2891		-
2892		- Finding the 'Host' header. No redirection is performed if this header is not found.
2893		-
2894		-define String
2895		- handle_redirection // returns the redirected URI
2896		- (
2897		- Redirections redirections,
2898		- String uri, // original URI
2899		- List(HTTP_header) headers
2900		- )=
2901		- if get_host_header_value(headers) is
2902		- {
2903		- failure then uri,
2904		- success(host) then
2905		- if redirections is
2906		- {
2907		- redirection_list(l) then handle_redirection(uri, host, l)
2908		- redirection_fn(f) then f(uri, host)
2909		- }
2910		- }.
2911		-
2912		-
2913		-
2914		-
2915		-
2916		-
2917		- *** [5.9] Answering both sorts of requests.
2918		-
2919		- We must decide if the request is www-url encoded or multipart/form-data encoded. This
2920		- is achieved through the header 'Content-Type'.
2921		-
2922		-define EncodingType
2923		- get_encoding_type
2924		- (
2925		- List(HTTP_header) headers
2926		- ) =
2927		- if headers is
2928		- {
2929		- [ ] then www_url, // this is the default
2930		- [h . t] then if h is http_header(name,value) then
2931		- if name = "content-type"
2932		- then if find("multipart/form-data",value,0) is
2933		- {
2934		- failure then www_url,
2935		- success(_) then multipart_form_data
2936		- }
2937		- else get_encoding_type(t)
2938		- }.
2939		-
2940		-
2941		-
2942		-define One
2943		- send_answer
2944		- (
2945		- String host_name,
2946		- Web_Site_Description desc,
2947		- Connection connection,
2948		- HTTP_RequestLine rqline,
2949		- List(HTTP_header) headers,
2950		- ByteArray body,
2951		- One -> String generate_tt
2952		- ) =
2953		- if rqline is request_line(type,uri,qstring) then
2954		- with rqline2 = request_line(type,handle_redirection(redirections(desc),uri,headers),qstring),
2955		- if remote_IP_address_and_port(connection) is (ip_addr,_) then
2956		- if get_encoding_type(headers) is
2957		- {
2958		- www_url then
2959		- www_url_answer(host_name,desc,connection,ip_addr,rqline2,headers,body,generate_tt),
2960		- multipart_form_data then
2961		- multipart_form_data_answer(host_name,desc,connection,ip_addr,rqline2,headers,body,generate_tt)
2962		- }.
2963		-
2964		-
2965		-
2966		-
2967		-
2968		-
2969		-
2970		- *** [6] The HTTP/HTTPS server.
2971		-
2972		- The command 'start_server' (declared in 'predefined.anubis') starts a virtual machine
2973		- which opens a server TCP/IP connection, and which continuously listens to this
2974		- connection. When a request arrives, this machine delegates the work of deciphering and
2975		- answering the request to another virtual machine, and continues to listen. The job of
2976		- the delegated machine is defined by the HTTP request handler below.
2977		-
2978		-
2979		-
2980		-
2981		-
2982		- *** [6.1] Determining the requested host.
2983		-
2984		- When a request arrives to one of our two servers, we must decide which site (host) is
2985		- requested.
2986		-
2987		-define Maybe(String)
2988		- get_host_header_value
2989		- (
2990		- List(HTTP_header) headers
2991		- ) =
2992		- if headers is
2993		- {
2994		- [ ] then failure,
2995		- [h . t] then if h is http_header(name,value) then
2996		- if name = "host"
2997		- then success(strip_port(value,0))
2998		- else get_host_header_value(t)
2999		- }.
3000		-
3001		-define Maybe((String,Web_Site_Description))
3002		- get_site
3003		- (
3004		- String requested_host,
3005		- List(Web_Site_Description) sites
3006		- ) =
3007		- if sites is
3008		- {
3009		- [ ] then print("Requested host '"+requested_host+"' does not exist.\n"); failure,
3010		- [site1 . others] then
3011		- if site1 is web_site_description(common_names,_,_,_,_,_,_,_,_,_) then
3012		- if member(common_names,requested_host)
3013		- then success((requested_host,site1))
3014		- else get_site(requested_host,others)
3015		- }.
3016		-
3017		-
3018		-define Maybe((String,Web_Site_Description))
3019		- get_site
3020		- (
3021		- List(HTTP_header) headers,
3022		- List(Web_Site_Description) sites
3023		- ) =
3024		- if get_host_header_value(headers) is
3025		- {
3026		- failure then print("No 'Host' HTTP header.\n"); failure,
3027		- success(requested_host) then
3028		- //here we treat the case with only one site. hence we accept any host request
3029		- //print("*** there is " +length(sites) + " sites \n");
3030		- if length(sites) = 1 then
3031		- //with site = force_nth(0, sites),
3032		- if sites is
3033		- {
3034		- [] then get_site(requested_host,sites),
3035		- [site . t] then success((requested_host, site))
3036		- }
3037		- else
3038		- get_site(requested_host,sites)
3039		- }.
3040		-
3041		-
3042		-
3043		-
3044		-
3045		- *** [6.2] The HTTP request handler.
3046		-
3047		- Here is the HTTP/HTTPS handler. It is called at each new request in a separate virtual
3048		- machine. It reads the headers of the HTTP request, determines the host, determines body
3049		- size, reads the body of the HTTP request, and answers the request.
3050		-
3051		-
3052		-
3053		-define One -> String make_generate_trust_ticket(DenialOfService dos).
3054		-
3055		-define One
3056		- http_https_handler
3057		- (
3058		- List(Web_Site_Description) sites,
3059		- BufferedConnection connection,
3060		- Bool is_https,
3061		- DenialOfService dos
3062		- ) =
3063		- //t0 <- (UTime)unow;
3064		- with start_time = (Int)now,
3065		- sttm <- start_time;
3066		- //println("Request time: " + format_http_date(start_time));
3067		- if dos is denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
3068		- if remote_IP_address_and_port(connection.conn) is (ip_addr,port) then
3069		- if read_request_line(connection,start_time+*rld_v,dos) is
3070		- {
3071		- error(msg) then print(format(msg)),
3072		- ok(request_line) then
3073		- //print_delta("read_request_line");
3074		- if read_http_headers(connection,start_time+*hd_v,dos) is
3075		- {
3076		- error(msg) then print(format(msg)),
3077		- ok(headers) then //print_delta("read_http_headers");
3078		- if get_site(headers,sites) is
3079		- {
3080		- failure then unique,
3081		- success(p) then if p is (host_name,desc) then
3082		- //print_delta("get_site");
3083		- if get_body_size(headers) is
3084		- {
3085		- error(msg) then log_journal_msg(desc,format(msg)),
3086		- ok(body_size) then
3087		- //print_delta("get_body_size");
3088		- if read_http_body(connection,body_size,constant_byte_array(0,0),1000) is
3089		- {
3090		- error(msg) then log_journal_msg(desc,format(msg)),
3091		- ok(body) then
3092		- //print_delta("before send_answer");
3093		- send_answer(host_name, desc,connection.conn, request_line, headers, body,
3094		- make_generate_trust_ticket(dos))
3095		- //with duration = (UTime) unow - *t0,
3096		- //println("Request duration: " + __utime_to_string(duration))
3097		- //println("BufferRead duration: " + __utime_to_string(*t1));
3098		- //println("next_char duration: " + __utime_to_string(*t2))
3099		- }
3100		- }
3101		- }
3102		- }
3103		- }.
3104		-
3105		-
3106		- Below are the two tools for constructing the handlers required by 'start_server' and
3107		- 'start_ssl_server' (see 'predefined.anubis').
3108		-
3109		-define Bool is_dubious_IP(Word32 ip, DenialOfService dos).
3110		-
3111		-define Server -> ((RWStream) -> One)
3112		- make_http_handler
3113		- (
3114		- List(Web_Site_Description) sites,
3115		- DenialOfService dos
3116		- ) =
3117		- (Server server) \|-> (RWStream conn) \|->
3118		- if remote_IP_address_and_port(conn) is (addr,_) then
3119		- if is_dubious_IP(addr,dos)
3120		- then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
3121		- else
3122		- with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),
3123		- http_https_handler(sites, connection, false, dos).
3124		-
3125		-define Server -> (SSL_Connection -> One)
3126		- make_https_handler
3127		- (
3128		- List(Web_Site_Description) sites,
3129		- DenialOfService dos
3130		- ) =
3131		- (Server server) \|-> (SSL_Connection conn) \|->
3132		- with connection = buffered_connection(ssl(conn), var(constant_byte_array(0, 0)), var(0)),
3133		- http_https_handler(sites, connection, true, dos).
3134		-
3135		-
3136		-
3137		-
3138		- *** [6.3] Server's tasks.
3139		-
3140		- Some tasks must be executed periodically, for example for cleaning up directories from
3141		- short life time files.
3142		-
3143		- The next function removes from the given directory (and recursively from its
3144		- subdirectories) all the files which are more than 10 minutes old.
3145		-
3146		-define One
3147		- cleanup_directory_10mn
3148		- (
3149		- String dir // path of private download directory (or subdirectory) with trailing slash
3150		- ) =
3151		- forget(map((FileDescription fd) \|-> if fd is
3152		- {
3153		- no_info(name) then forget(remove(dir+name)),
3154		- file(name,_,_,d) then if to_Int(d)+600 < now then forget(remove(dir+name)) else unique,
3155		- link(name,_,_,d) then if to_Int(d)+600 < now then forget(remove(dir+name)) else unique,
3156		- directory(name,_,_) then cleanup_directory_10mn(dir+name+"/"),
3157		- },
3158		- directory_full_list(dir,"","","*"))).
3159		-
3160		-
3161		-define One
3162		- http_servers_tasks
3163		- (
3164		- List(Web_Site_Description) sites,
3165		- List(Server) servers,
3166		- Int period,
3167		- Int next_time,
3168		- ) =
3169		- if mapand(is_down,servers)
3170		- then unique
3171		- else if now > next_time
3172		- then
3173		- (
3174		- /*
3175		- forget(map((Web_Site_Description wsd) \|->
3176		- cleanup_directory_10mn(site_directory(wsd)+"/private_download/"),
3177		- sites));
3178		- */
3179		- http_servers_tasks(sites,servers,period,next_time+period)
3180		- )
3181		- else
3182		- (
3183		- sleep(1000);
3184		- http_servers_tasks(sites,servers,period,next_time)
3185		- ).
3186		-
3187		-
3188		-public define One
3189		- start_http_servers_tasks
3190		- (
3191		- List(Web_Site_Description) sites,
3192		- List(Server) servers,
3193		- Int period
3194		- ) =
3195		- delegate http_servers_tasks(sites,servers,period,now),
3196		- unique.
3197		-
3198		-
3199		-
3200		-
3201		- *** [6.4] Protection against 'denial of service' attacks.
3202		-
3203		-
3204		- *** [6.4.1] Counting connections.
3205		-
3206		-define Bool // returns false if the counter cannot be incremented (too many connections)
3207		- increment_connections_counter
3208		- (
3209		- Var(Int) counter
3210		- ) =
3211		- protect with n = *counter,
3212		- if n >= 100
3213		- then false
3214		- else (counter <- (*counter)+1); true.
3215		-
3216		-define One
3217		- decrement_connections_counter
3218		- (
3219		- Var(Int) counter
3220		- ) =
3221		- protect counter <- (*counter)-1.
3222		-
3223		-
3224		-
3225		-
3226		-
3227		- *** [6.4.2] Recording dubious IP addresses.
3228		-
3229		-
3230		-define List(DubiousIP)
3231		- record_dubious_IP
3232		- (
3233		- Word32 ip,
3234		- List(DubiousIP) l
3235		- ) =
3236		- if l is
3237		- {
3238		- [ ] then [dubious_ip(ip,now)],
3239		- [h . t] then if h is dubious_ip(addr,time) then
3240		- if addr = ip
3241		- then [dubious_ip(addr,now) . t]
3242		- else [h . record_dubious_IP(ip,t)]
3243		- }.
3244		-
3245		-
3246		-define One
3247		- record_dubious_IP
3248		- (
3249		- Word32 dubious_IP,
3250		- Var(List(DubiousIP)) v
3251		- ) =
3252		- protect v <- record_dubious_IP(dubious_IP,*v).
3253		-
3254		-
3255		-define One
3256		- record_dubious_IP
3257		- (
3258		- Word32 addr,
3259		- DenialOfService dos
3260		- ) =
3261		- record_dubious_IP(addr,list_of_dubious(dos)).
3262		-
3263		-
3264		-public define DenialOfService
3265		- load_denial_of_service_info
3266		- =
3267		- if (RetrieveResult(DenialOfService))retrieve(my_anubis_directory+"/web_sites/dos_info") is
3268		- ok(dos) then dos else denial_of_service(
3269		- var(100),
3270		- var(1000),
3271		- var(1500),
3272		- var(2000),
3273		- var([]),
3274		- var([])).
3275		-
3276		-
3277		-
3278		-
3279		- *** [6.4.3] Testing if an address is dubious.
3280		-
3281		-define Bool
3282		- is_dubious_IP
3283		- (
3284		- Word32 ip,
3285		- List(DubiousIP) l
3286		- ) =
3287		- if l is
3288		- {
3289		- [ ] then false,
3290		- [h . t] then if h is dubious_ip(addr,time) then
3291		- if ip = addr
3292		- then true
3293		- else is_dubious_IP(ip,t)
3294		- }.
3295		-
3296		-
3297		-define Bool
3298		- is_dubious_IP
3299		- (
3300		- Word32 ip,
3301		- DenialOfService dos
3302		- ) =
3303		- if dos is
3304		- {
3305		- denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
3306		- if member(*ra_v,ip) then false else
3307		- is_dubious_IP(ip,*ld_v)
3308		- }.
3309		-
3310		-
3311		-
3312		-
3313		- *** [6.4.4] Removing inactive dubious IP addresses.
3314		-
3315		-define List(DubiousIP)
3316		- remove_inactive_dubious_IP
3317		- (
3318		- List(DubiousIP) l,
3319		- Int ref_time,
3320		- ) =
3321		- if l is
3322		- {
3323		- [ ] then [ ],
3324		- [h . t] then if h is dubious_ip(addr,time) then
3325		- if time < ref_time
3326		- then (print(ip_addr_to_string(addr)+" removed from dubious addresses list.\n");
3327		- remove_inactive_dubious_IP(t,ref_time))
3328		- else [h . remove_inactive_dubious_IP(t,ref_time)]
3329		- }.
3330		-
3331		-define One
3332		- remove_inactive_dubious_IP
3333		- (
3334		- Var(List(DubiousIP)) v
3335		- ) =
3336		- protect
3337		- with ref_time = (Int)now - 600, // 10 minutes
3338		- v <- remove_inactive_dubious_IP(*v,ref_time).
3339		-
3340		-
3341		- The above function will be executed periodically by the servers's tasks machine.
3342		-
3343		-
3344		-
3345		- *** [6.4.5] Making the function for generating trust tickets.
3346		-
3347		-define One -> String
3348		- make_generate_trust_ticket
3349		- (
3350		- DenialOfService dos
3351		- ) =
3352		- (One _) \|-> "".
3353		-
3354		-
3355		-
3356		-
3357		-
3358		-
3359		-
3360		- *** [6.5] Starting the HTTP/HTTPS server.
3361		-
3362		-
3363		- The next function creates the directories for all sites (if they don't already exist).
3364		-
3365		-define One
3366		- create_directories
3367		- (
3368		- List(Web_Site_Description) sites
3369		- ) =
3370		- if sites is
3371		- {
3372		- [ ] then unique,
3373		- [s1 . others] then
3374		- with site_dir = site_directory(s1),
3375		- forget(make_directory(site_dir+"/public",default_directory_mode));
3376		- forget(make_directory(site_dir+"/upload_temporary",default_directory_mode));
3377		- forget(make_directory(site_dir+"/private_download",default_directory_mode));
3378		- forget(make_directory(site_dir+"/journal",default_directory_mode));
3379		- create_directories(others)
3380		- }.
3381		-
3382		-
3383		-
3384		-
3385		-
3386		- Below are the commands for starting an HTTP server and an HTTPS server.
3387		-
3388		-
3389		-define StartServerResult
3390		- start_http_server
3391		- (
3392		- Word32 ip_address,
3393		- Word32 port,
3394		- Server -> ((RWStream) -> One) handler,
3395		- Int retries,
3396		- DenialOfService dos
3397		- ) =
3398		- if start_server(ip_address,
3399		- port,
3400		- handler,
3401		- identity) is ok(server)
3402		- then print(" \r");
3403		- ok(server)
3404		- else print("Port "+port+": retry number "+retries+"\r");
3405		- sleep(1000);
3406		- start_http_server(ip_address,port,handler,retries+1,dos).
3407		-
3408		-public define StartServerResult
3409		- start_http_server
3410		- (
3411		- Word32 ip_address,
3412		- Word32 port,
3413		- List(Web_Site_Description) sites,
3414		- DenialOfService dos
3415		- ) =
3416		- create_directories(sites);
3417		- start_http_server(ip_address,port,
3418		- make_http_handler(sites,dos),
3419		- 0,
3420		- dos).
3421		-
3422		-
3423		- For the HTTPS server, we have a problem which is due to the fact that 'anbexec' is not
3424		- yet able to manipulate several SSL server certificates. 'anbexec' and
3425		- 'predefined.anubis' must be changed. Sorry ! This will be done as soon as possible. The
3426		- 'solution' for the time being is to provide the common name of the unique SSL server
3427		- certificate.
3428		-
3429		-
3430		-define StartServerResult
3431		- start_https_server
3432		- (
3433		- Word32 ip_address,
3434		- Word32 port,
3435		- String certificate_common_name,
3436		- Server -> (SSL_Connection -> One) handler,
3437		- Int retries,
3438		- DenialOfService dos
3439		- ) =
3440		- if start_ssl_server(ip_address,
3441		- port,
3442		- certificate_common_name,
3443		- handler,
3444		- identity) is ok(server)
3445		- then print(" \r");
3446		- ok(server)
3447		- else print("Port "+port+": retry number "+retries+"\r");
3448		- sleep(1000);
3449		- start_https_server(ip_address,port,
3450		- certificate_common_name,
3451		- handler,retries+1,
3452		- dos).
3453		-
3454		-
3455		-public define StartServerResult
3456		- start_https_server
3457		- (
3458		- Word32 ip_address,
3459		- Word32 port,
3460		- String certificate_common_name, // of SSL server certificate
3461		- List(Web_Site_Description) sites,
3462		- DenialOfService dos
3463		- ) =
3464		- create_directories(sites);
3465		- start_https_server(ip_address,port,certificate_common_name,
3466		- make_https_handler(sites,dos),
3467		- 0,dos).
3468		-
3469		-
3470		-
3471		-
3472		-
3473		-
3474		-
3475		-
3476		-
3477		- *** [7] The web dispatcher.
3478		-
3479		-
3480		- *** [7.1] The dispatcher server.
3481		-
3482		-define One
3483		- send_dispatching_page
3484		- (
3485		- RWStream conn,
3486		- String common_name,
3487		- Word32 port
3488		- ) =
3489		- print("Dispatching '"+common_name+"' to port "+port+"\n");
3490		- forget(reliable_write(conn,to_byte_array(
3491		- "<html><head><meta http-equiv=\"Refresh\" content=\"0;URL="+
3492		- "http://"+common_name+":"+port+"/"+
3493		- "\"></head><body></body></html>"
3494		- ))).
3495		-
3496		-
3497		-
3498		-define Maybe(DispatcherInfo)
3499		- find_host
3500		- (
3501		- List(DispatcherInfo) l,
3502		- String host
3503		- ) =
3504		- if l is
3505		- {
3506		- [ ] then failure,
3507		- [h . t] then if h is site(name,port) then
3508		- if name = host
3509		- then success(h)
3510		- else find_host(t,host)
3511		- }.
3512		-
3513		-
3514		-
3515		-define Server -> ((RWStream) -> One)
3516		- make_dispatcher_handler
3517		- (
3518		- Var(List(DispatcherInfo)) info_v,
3519		- DenialOfService dos
3520		- ) =
3521		- (Server server) \|-> (RWStream conn) \|->
3522		- with start_time = (Int)now,
3523		- connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),
3524		- if read_request_line(connection, start_time+*request_line_delay(dos), dos) is
3525		- {
3526		- error(msg) then print(format(msg)),
3527		- ok(request_line) then
3528		- if read_http_headers(connection, start_time+*headers_delay(dos), dos) is
3529		- {
3530		- error(msg) then print(format(msg)),
3531		- ok(headers) then if get_host_header_value(headers) is
3532		- {
3533		- failure then print("No 'HOST' HTTP header.\n"),
3534		- success(host) then
3535		- if find_host(*info_v,host) is
3536		- {
3537		- failure then print("Host: '"+host+"' not registered.\n"),
3538		- success(s) then if s is site(common_name,ip_port) then
3539		- send_dispatching_page(conn,common_name,ip_port)
3540		- }
3541		- }
3542		- }
3543		- }.
3544		-
3545		-
3546		-define One
3547		- dispatcher_update_error
3548		- (
3549		- String file_path
3550		- ) =
3551		- print("web_dispatcher: unable to reread file: '"+file_path+"'.\n").
3552		-
3553		-
3554		-define Bool
3555		- dispatcher_update_data
3556		- (
3557		- String info_file_path,
3558		- Var(List(DispatcherInfo)) info_v,
3559		- Var(Int) info_date_v
3560		- ) =
3561		- if directory_full_list(my_anubis_directory+"/web_sites","dispatcher.info","","") is
3562		- {
3563		- [ ] then false,
3564		- [h . t] then if h is
3565		- {
3566		- no_info(n) then false,
3567		- file(n,_,_,d) then if n = "dispatcher.info"
3568		- then (info_date_v <- to_Int(d);
3569		- if (RetrieveResult(List(DispatcherInfo)))retrieve(info_file_path) is
3570		- {
3571		- cannot_find_file then false,
3572		- read_error then false,
3573		- type_error then false,
3574		- ok(info) then info_v <- info; true
3575		- })
3576		- else false,
3577		- link(_,_,_,_) then false,
3578		- directory(_,_,_) then false
3579		- }
3580		- }.
3581		-
3582		-
3583		-
3584		- The loop within which the dispatcher updates its data every 3 seconds:
3585		-
3586		-define One
3587		- dispatcher_update_task
3588		- (
3589		- String info_file_path,
3590		- Var(List(DispatcherInfo)) info_v,
3591		- Var(Int) info_date_v
3592		- ) =
3593		- sleep(3000);
3594		- (if dispatcher_update_data(info_file_path,info_v,info_date_v)
3595		- then unique
3596		- else dispatcher_update_error(info_file_path));
3597		- dispatcher_update_task(info_file_path,info_v,info_date_v).
3598		-
3599		-
3600		-public define One
3601		- start_web_dispatcher
3602		- (
3603		- Word32 ip_address, // address for listening (typically 0: listen on all interfaces)
3604		- Word32 http_port, // typically 80
3605		- DenialOfService dos
3606		- ) =
3607		- with info_file_path = my_anubis_directory+"/web_sites/dispatcher.info",
3608		- info_v = var((List(DispatcherInfo))[]),
3609		- info_date_v = var((Int)0),
3610		- if dispatcher_update_data(info_file_path,info_v,info_date_v)
3611		- then if start_server(ip_address,
3612		- http_port,
3613		- make_dispatcher_handler(info_v,dos),
3614		- (One u)\|->u) is
3615		- {
3616		- cannot_create_the_socket then
3617		- print("Cannot create the socket for HTTP server.\n"),
3618		- cannot_bind_to_port then
3619		- print("Cannot bind HTTP server to port "+http_port+".\n"),
3620		- cannot_listen_on_port then
3621		- print("HTTP server cannot listen on port "+http_port+".\n"),
3622		- ok(http_server) then
3623		- dispatcher_update_task(info_file_path,info_v,info_date_v)
3624		- }
3625		- else dispatcher_update_error(info_file_path).
3626		-
3627		-
3628		-
3629		- *** [7.2] The dispatcher web site.
3630		-
3631		- global define One
3632		- web_dispatcher
3633		- (
3634		- List(String) args
3635		- ) =
3636		- start_web_dispatcher(0,80,load_denial_of_service_info).
3637		-
3638		-
3639		-
3640		-
3641		-
3642		-
3643		- *** [7.3] Managing the info file.
3644		-
3645		-define Word32
3646		- register_ip_address
3647		- =
3648		- if ip_address(prompt(" numerical IP address (for HTTP): ")) is
3649		- {
3650		- failure then print(" *** Error: incorrect IP address.\n");
3651		- register_ip_address,
3652		- success(n) then n
3653		- }.
3654		-
3655		-
3656		-define Word32
3657		- register_ip_port
3658		- =
3659		- if decimal_scan(prompt(" IP port (for HTTP): ")) is
3660		- {
3661		- failure then print(" *** Error: incorrect IP port.\n");
3662		- register_ip_port,
3663		- success(p) then if (0 =< p & p =< 65535)
3664		- then truncate_to_Word32(p)
3665		- else print(" *** Error: IP port out of bounds.\n");
3666		- register_ip_port
3667		- }.
3668		-
3669		-
3670		-define One
3671		- register_new_site
3672		- (
3673		- Var(List(DispatcherInfo)) info_v
3674		- ) =
3675		- print("\n");
3676		- print(" Registering a new site:\n");
3677		- with name = prompt(" Site name: "),
3678		- with addr = register_ip_address,
3679		- with port = register_ip_port,
3680		- (protect info_v <- [site(name,port) . *info_v]);
3681		- print(" Site "+name+" at "+ip_addr_to_string(addr)+":"+port+" added\n (but not saved to disk).\n").
3682		-
3683		-
3684		-define List(DispatcherInfo)
3685		- find_sites
3686		- (
3687		- List(DispatcherInfo) l,
3688		- String name
3689		- ) =
3690		- if l is
3691		- {
3692		- [ ] then [ ],
3693		- [h . t] then if h is site(n,_) then
3694		- if find(name,n,0) is
3695		- {
3696		- failure then find_sites(t,name),
3697		- success(_) then [h . find_sites(t,name)]
3698		- }
3699		- }.
3700		-
3701		-
3702		-define String
3703		- pad
3704		- (
3705		- String s,
3706		- Int l
3707		- ) =
3708		- if length(s) >= l
3709		- then s
3710		- else s+constant_string(l-length(s),' ').
3711		-
3712		-
3713		-
3714		-define One
3715		- show_sites_1
3716		- (
3717		- List(DispatcherInfo) l,
3718		- Int i
3719		- ) =
3720		- if l is
3721		- {
3722		- [ ] then unique,
3723		- [h . t] then if h is site(name,port) then
3724		- print(" ["+i+"] "+pad(name,40)+" "+" "+port+"\n");
3725		- show_sites_1(t,i+1)
3726		- }.
3727		-
3728		-
3729		-define One
3730		- show_sites
3731		- (
3732		- List(DispatcherInfo) l,
3733		- Int i
3734		- ) =
3735		- print(" Name Port\n");
3736		- print(" --------------------------------------------------------\n");
3737		- show_sites_1(l,i).
3738		-
3739		-define List(DispatcherInfo)
3740		- replace_info
3741		- (
3742		- List(DispatcherInfo) l,
3743		- String site_name,
3744		- Word32 new_port
3745		- ) =
3746		- if l is
3747		- {
3748		- [ ] then print("ALERT: Empty list into replace_info() [" + __FILE__ + "]\n"); [],
3749		- [h . t] then if h is site(n,_) then
3750		- if n = site_name
3751		- then [site(n,new_port) . t]
3752		- else [h . replace_info(t,site_name,new_port)]
3753		- }.
3754		-
3755		-define List(DispatcherInfo)
3756		- delete_info
3757		- (
3758		- List(DispatcherInfo) l,
3759		- String site_name,
3760		- ) =
3761		- if l is
3762		- {
3763		- [ ] then print("ALERT: Empty list into delete_info() [" + __FILE__ + "]\n"); [],
3764		- [h . t] then if h is site(n,_) then
3765		- if n = site_name
3766		- then t
3767		- else [h . delete_info(t,site_name)]
3768		- }.
3769		-
3770		-
3771		-define One
3772		- update_site
3773		- (
3774		- Var(List(DispatcherInfo)) info_v,
3775		- String site_name,
3776		- Word32 old_port
3777		- ) =
3778		- print("\n");
3779		- print(" Updating site '"+site_name+"': (currently: "+old_port+")\n");
3780		- with new_port = register_ip_port,
3781		- answer = prompt(" Update '"+site_name+"' as: "+new_port+" [Y/N] ? "),
3782		- if (answer = "Y" \| answer = "y")
3783		- then info_v <- replace_info(*info_v,site_name,new_port)
3784		- else unique.
3785		-
3786		-
3787		-
3788		-define Bool
3789		- compare
3790		- (
3791		- DispatcherInfo d1,
3792		- DispatcherInfo d2
3793		- ) =
3794		- if d1 is site(n1,_) then
3795		- if d2 is site(n2,_) then
3796		- string_less(n1,n2).
3797		-
3798		-
3799		-
3800		-define One
3801		- update_site
3802		- (
3803		- Var(List(DispatcherInfo)) info_v
3804		- ) =
3805		- print("\n");
3806		- with prefix = prompt(" Search for site to update: "),
3807		- if find_sites(*info_v,prefix) is
3808		- {
3809		- [ ] then print(" No site found.\n");
3810		- update_site(info_v),
3811		- [h . t] then
3812		- show_sites(qsort([h . t],compare),1);
3813		- with i1 = prompt(" Choose a site to update [1/.../"+(length(t)+1)+"]: "),
3814		- if decimal_scan(i1) is
3815		- {
3816		- failure then print(" *** Error: site number not recognized.\n");
3817		- update_site(info_v),
3818		- success(ii1) then if nth(ii1-1,*info_v) is
3819		- {
3820		- failure then print(" *** Error: site number "+i1+" does not exist.\n");
3821		- update_site(info_v),
3822		- success(site_info) then if site_info is site(name,old_port) then
3823		- update_site(info_v,name,old_port)
3824		- }
3825		- }
3826		- }.
3827		-
3828		-
3829		-define One
3830		- delete_site
3831		- (
3832		- Var(List(DispatcherInfo)) info_v,
3833		- String site_name,
3834		- Word32 old_port
3835		- ) =
3836		- print("\n");
3837		- print(" Deleting site '"+site_name+"': (currently: "+old_port+")\n");
3838		- with answer = prompt(" Are you sure you want to delete site: '"+site_name+"' [Y/N] ? "),
3839		- if (answer = "Y" \| answer = "y")
3840		- then info_v <- delete_info(*info_v,site_name)
3841		- else print(" Site '"+site_name+"' not deleted.\n").
3842		-
3843		-
3844		-define One
3845		- delete_site
3846		- (
3847		- Var(List(DispatcherInfo)) info_v
3848		- ) =
3849		- print("\n");
3850		- with prefix = prompt(" Search for site to delete: "),
3851		- if find_sites(*info_v,prefix) is
3852		- {
3853		- [ ] then print(" No site found.\n");
3854		- delete_site(info_v),
3855		- [h . t] then
3856		- show_sites(qsort([h . t],compare),1);
3857		- with i1 = prompt(" Choose a site to delete [1/.../"+(length(t)+1)+"]: "),
3858		- if decimal_scan(i1) is
3859		- {
3860		- failure then print(" *** Error: site number not recognized.\n");
3861		- delete_site(info_v),
3862		- success(ii1) then if nth(ii1-1,*info_v) is
3863		- {
3864		- failure then print(" *** Error: site number "+i1+" does not exist.\n");
3865		- delete_site(info_v),
3866		- success(site_info) then if site_info is site(name,old_port) then
3867		- delete_site(info_v,name,old_port)
3868		- }
3869		- }
3870		- }.
3871		-
3872		-
3873		-define One
3874		- manager
3875		- (
3876		- Var(List(DispatcherInfo)) info_v,
3877		- String file_path
3878		- ) =
3879		- print("\n");
3880		- print(" --- Welcome to the Web Dispatcher Manager ---\n");
3881		- with l = length(*info_v),
3882		- print(" "+l+" site"+(if l>1 then "s" else "")+" currently registred.\n");
3883		- print(" [L] List registered sites.\n");
3884		- print(" [R] Register a new site.\n");
3885		- print(" [U] Update a registred site.\n");
3886		- print(" [D] Delete a registred site.\n");
3887		- with propose_write_v = var((Bool)true),
3888		- action = prompt(" Choose an action [L/R/U/D]: "),
3889		- (if (action = "L" \| action = "l") then (show_sites(*info_v,1); propose_write_v <- false) else
3890		- if (action = "R" \| action = "r") then register_new_site(info_v) else
3891		- if (action = "U" \| action = "u") then update_site(info_v) else
3892		- if (action = "D" \| action = "d") then delete_site(info_v) else
3893		- print("Action not recognized.\n"));
3894		- print("\n");
3895		- if *propose_write_v then
3896		- with result = prompt(" Write modifications to data base [Y/N] ?"),
3897		- if (result = "Y" \| result = "y")
3898		- then if save(*info_v,file_path) is
3899		- {
3900		- cannot_open_file then print(" File '"+file_path+"' not found.\n"),
3901		- write_error then print(" Error while writing file '"+file_path+"'.\n"),
3902		- ok then print(" Data base has been modified.\n")
3903		- }
3904		- else print(" Data base not modified.\n")
3905		- else unique.
3906		-
3907		-
3908		-
3909		-global define One
3910		- manage_web_dispatcher
3911		- (
3912		- List(String) args
3913		- ) =
3914		- with info_v = var((List(DispatcherInfo))[]),
3915		- with file_path = my_anubis_directory+"/web_sites/dispatcher.info",
3916		- if (RetrieveResult(List(DispatcherInfo)))retrieve(file_path) is
3917		- {
3918		- cannot_find_file then print("File '"+file_path+"' does not exist.\n");
3919		- with answer = prompt("Create it [Y/N] ? "),
3920		- if (answer = "Y" \| answer = "y")
3921		- then if save((List(DispatcherInfo))[],file_path) is
3922		- {
3923		- cannot_open_file then
3924		- print("Cannot create file '"+file_path+"'.\n"),
3925		- write_error then
3926		- print("Error while creating file '"+file_path+"'.\n"),
3927		- ok then manager(info_v,file_path)
3928		- }
3929		- else unique,
3930		- read_error then print("Error while reading file '"+file_path+"'.\n"),
3931		- type_error then print("File '"+file_path+"' is corrupted.\n"),
3932		- ok(info) then info_v <- info;
3933		- manager(info_v,file_path)
3934		- }.
3935		-
3936		-
3937		-
3938		-
3939		-
3940		-public define (String, List(HTTP_header))
3941		- format
3942		- (
3943		- HTTP_Status status
3944		- ) =
3945		- if status is
3946		- {
3947		- http_continue then ("100 Continue", []),
3948		- http_switching_protocol then ("101 Switching Protocols", []),
3949		-
3950		- http_ok then ("200 OK", []),
3951		- http_created then ("201 Created", []),
3952		- http_accepted then ("202 Accepted", []),
3953		- http_non_authoritative_info then ("203 Non-Authoritative Information", []),
3954		- http_no_content then ("204 No Content", []),
3955		- http_reset_content then ("205 Reset Content", []),
3956		- http_partial_content then ("206 Partial Content", []),
3957		-
3958		- http_multiple_choices then ("300 Multiple Choices", []),
3959		- http_moved_permanently(loc) then ("301 Moved Permanently", [http_header("Location", loc)]),
3960		- http_moved_temporarily(loc) then ("302 Moved Temporarily", [http_header("Location", loc)]),
3961		- http_see_other(loc) then ("303 See Other", [http_header("Location", loc)]),
3962		- http_not_modified then ("304 Not Modified", []),
3963		- http_use_proxy(loc) then ("305 Use Proxy", [http_header("Location", loc)]),
3964		- http_temporary_redirect(loc) then ("307 Temporary Redirect", [http_header("Location", loc)]),
3965		-
3966		- http_bad_request then ("400 Bad Request", []),
3967		- http_unauthorized then ("401 Unauthorized", []),
3968		- http_payment_required then ("402 Payment Required", []),
3969		- http_forbidden then ("403 Forbidden", []),
3970		- http_not_found then ("404 Not Found", []),
3971		- http_method_not_allowed then ("405 Method Not Allowed", []),
3972		- http_not_acceptable then ("406 Not Acceptable", []),
3973		- http_proxy_authentification_required then ("407 Proxy Authentication Required", []),
3974		- http_request_timeout then ("408 Request Time-out", []),
3975		- http_conflict then ("409 Conflict", []),
3976		- http_gone then ("410 Gone", []),
3977		- http_length_required then ("411 Length Required", []),
3978		- http_precondition_failed then ("412 Precondition Failed", []),
3979		- http_request_entity_too_large then ("413 Request Entity Too Large", []),
3980		- http_request_uri_too_long then ("414 Request-URI Too Long", []),
3981		- http_unsupported_media_type then ("415 Unsupported Media Type", []),
3982		- http_request_range_unsatisfiable then ("416 Requested range unsatisfiable", []),
3983		- http_expectation_failed then ("417 Expectation failed", []),
3984		-
3985		- http_internal_server_error then ("500 Internal Server Error", []),
3986		- http_not_implemented then ("501 Not Implemented", []),
3987		- http_bad_gateway then ("502 Bad Gateway", []),
3988		- http_service_unavailable then ("503 Service Unavailable", []),
3989		- http_gateway_timeout then ("504 Gateway Time-out", []),
3990		- http_version_not_supported then ("505 HTTP Version not supported", []),
3991		-
3992		- http_error(code, message) then (abs_to_decimal(code) + " " + message, [])
3993		- }.
3994		-
3995		-
	1	+
	2	+ Project The Anubis Project
	3	+
	4	+ Title A Multi Host HTTP/HTTPS Server
	5	+
	6	+ Copyright Copyright (c) Anubis Team 2003-2007.
	7	+
	8	+
	9	+ Authors Alain Prouté
	10	+ David René
	11	+ Cédric Ricard
	12	+
	13	+
	14	+ Revised July 2007.
	15	+
	16	+
	17	+
	18	+ Overviews
	19	+ In this file a HTTP/HTTPS server is defined, which is able to handle multiple hosts
	20	+ (virtual hosts). It answers HTTP/HTTPS requests, sends files (images or any other kind
	21	+ of file), constructs HTML pages on the fly using informations received from the client
	22	+ (when the URI ends by '.awp'), handles uploading of files and redirections. It is
	23	+ multitasking by itself, and can handle any number of sites and clients simultaneously.
	24	+ It should better be used in conjunction with 'making_a_web_site.anubis' to be found in
	25	+ the same directory. If you use 'web/making_a_web_site.anubis', you don't need to read
	26	+ this file.
	27	+
	28	+
	29	+ ----------------------------------- Table of Contents ---------------------------------
	30	+
	31	+ *** (1) Multihosting and redirections.
	32	+ *** (2) The incompatibility between SSL and virtual hosts.
	33	+ *** (3) HTTP headers and web arguments.
	34	+ *** (4) Site descriptions.
	35	+ *** (5) Protection against denial of service attacks.
	36	+ *** (6) Starting your HTTP and HTTPS servers.
	37	+ *** (7) Private download.
	38	+ *** (8) About web argument names.
	39	+ *** (9) A web dispatcher.
	40	+ *** (10) HTTP Errors
	41	+
	42	+ ---------------------------------------------------------------------------------------
	43	+
	44	+
	45	+
	46	+
	47	+ *** (1) Multihosting and redirections.
	48	+
	49	+ This HTTP/HTTPS server can handle several host (also called 'virtual hosts'), in other
	50	+ words, you may have several sites on the same server, with the same IP address and same
	51	+ port numbers, but distinct 'host names'.
	52	+
	53	+ A HTTP request sent by a browser contains the following informations:
	54	+
	55	+ - a 'host name',
	56	+ - an URI (Uniform Resource Identifier),
	57	+ - HTTP headers,
	58	+ - web arguments (in the form 'name=value').
	59	+
	60	+ Actually, the host name is just the value of the HTTP header whose name is 'Host'. The
	61	+ host name indicates which site is requested. Hence, it is the primary information for
	62	+ branching to the right site. If there is no 'Host' HTTP header in the request, the
	63	+ request is denied.
	64	+
	65	+ From now on, we may assume that the host is determined, and consequently that we are
	66	+ concerned by only one site. Each site has his own directories on the server's
	67	+ disk.
	68	+
	69	+ Each site also has a list of 'redirections'. A redirection is a triplet, like this one:
	70	+
	71	+ redirect("/", "www.our-business.com", "/homepage.awp")
	72	+
	73	+ meaning that if the host is "www.our-business.com", and if the requested URI is "/",
	74	+ then the URI to be served is "/homepage.awp". 'redirect' is a constructor of the type
	75	+ 'Redirection' defined in 'web/common.anubis'.
	76	+
	77	+ Now, an URI may end by ".awp" (meaning 'Anubis Web Page') or not. If it does, the
	78	+ server understands that an HTML page must be constructed on the fly, and to that end it
	79	+ calls the 'awp handler' of the site. Otherwise, the URI must end by a known extension,
	80	+ like ".jpg", ".png", ".txt", etc... and represents a file path relative to the
	81	+ 'public' directory of the site. If these conditions are satisfied, the file is sent to
	82	+ the client. Known extensions are recorded in 'web/mime.anubis'.
	83	+
	84	+
	85	+
	86	+
	87	+ *** (2) The incompatibility between SSL and virtual hosts.
	88	+
	89	+ Handling virtual hosts makes a problem under SSL (i.e. when using HTTPS), which is due
	90	+ to the fact that the guys at Netscape who designed SSL probably did not have the
	91	+ question of virtual hosts in mind. Indeed, the SSL handshake is completed before the
	92	+ server can know about the value of the 'Host' HTTP header, so that it cannot know which
	93	+ server certificate must be sent to the client. This makes a problem, because the
	94	+ browser will not accept a certificate whose common name does not correspond to the name
	95	+ of the requested host. The user will have to accept the certificate manually, which is
	96	+ not good for the security image of the site. This problem has at least two solutions
	97	+ (as far as Anubis is concerned).
	98	+
	99	+ Solution 1. Arrange so that the network interface on which the server is listening
	100	+ has at least as many different IP addresses as you have virtual hosts. Such
	101	+ supplementary IP addresses are called 'IP Aliases'. In this case, start one HTTPS
	102	+ server for each virtual host, each one listening on a different address. For the time
	103	+ being, this method is applicable under Anubis only if you start as many instances of
	104	+ 'anbexec' as you have virtual hosts, because each instance of 'anbexec' can handle only
	105	+ one server certificate. Of course, getting IP aliases is another problem to be solved
	106	+ with your Internet provider.
	107	+
	108	+ Solution 2. We propose a simple solution, using only one server certificate (hence
	109	+ only one instance of 'anbexec'). Since, we have only one server certificate, we must
	110	+ introduce a notion of 'main host', i.e. a host containing all other 'virtual
	111	+ hosts'. The unique server certificate belong to the main host, so that only the main
	112	+ host is identified by the client. The client must trust the main host and be confident
	113	+ that the main host redirects him to the right virtual host. Actually, the process will
	114	+ be transparent to the client, except that the client will see the name of the main host
	115	+ instead of the name of the virtual host in the 'location' field of the browser.
	116	+
	117	+ So, assume that the name of main host is 'www.securedhost.com', and that the names of
	118	+ the virtual hosts are:
	119	+
	120	+ actual name simplified name
	121	+ -----------------------------------------------------
	122	+ www.virtual1.com virtual1
	123	+ www.virtual2.com virtual2
	124	+ www.virtual3.com virtual3
	125	+
	126	+ Then the (confidential) document '/doc/my_document.pdf' on 'www.virtual2.com' will have
	127	+ the URL:
	128	+
	129	+ https://www.securedhost.com/virtual2/doc/my_document.pdf
	130	+
	131	+ In order to work transparently, this solution must combine HTTP and HTTPS. Indeed, the
	132	+ vitual host must have a first page reachable under HTTP, through the URL:
	133	+
	134	+ http://www.virtual2.com/
	135	+
	136	+ The HTTP server will redirect this URL to the awp handler of virtual host 'virtual2'.
	137	+ The handler of this virtual host is able to generate a first page containing the
	138	+ following HTML meta:
	139	+
	140	+ <meta http-equiv="Refresh" content="0;URL=https://www.securedhost.com/virtual2/">,
	141	+
	142	+ so that the client is immediately redirected to the main host under HTTPS (hence
	143	+ accepting tranparently the server certificate). The awp handler of 'virtual2' then
	144	+ redirects this URL to the home page (maybe a login page) of 'virtual2'.
	145	+
	146	+ See 'web/making_a_web_site.anubis' for the sequel of this story.
	147	+
	148	+
	149	+
	150	+
	151	+
	152	+ *** (3) HTTP headers and web arguments.
	153	+
	154	+ Each HTTP request which arrives on the server contains a request line followed by a
	155	+ series of HTTP headers. Each HTTP header is a pair '(name,value)' assigning a value to
	156	+ a name. The type 'HTTP_header' is defined in 'web/common.anubis'.
	157	+
	158	+ The request may also have a 'body'. The body contains either 'web arguments' or
	159	+ uploaded files (or both). The request line itself may also contain web arguments (in a
	160	+ so-called 'query string'). Like HTTP headers, 'web arguments' are pairs
	161	+ '(name,value)', but the difference is that these pairs are generated by the page within
	162	+ which the client clicks, while HTTP headers are generated by the browser itself. The
	163	+ type 'Web_arg' is defined in 'web/common.anubis'. It has two alternatives, one for
	164	+ ordinary web arguments (pairs) and one for uploaded files.
	165	+
	166	+read CXM_common.anubis
	167	+read tools/basis.anubis
	168	+read tools/printable_tree.anubis
	169	+read system/string.anubis
	170	+read system/files.anubis
	171	+read system/lists.anubis
	172	+read web/mime.anubis
	173	+
	174	+
	175	+
	176	+ *** (4) Site descriptions.
	177	+
	178	+ The type HTTP_Info gathers informations comming along with the client's request. These
	179	+ informations are rarely used for composing HTML pages. Nevertheless, they are at your
	180	+ disposal.
	181	+
	182	+public type HTTP_Info:
	183	+ http_info
	184	+ (
	185	+ Word32 ip_address, // IP address of the client
	186	+ String hostname, // hostname requested by the client
	187	+ String uri, // URI requested by the client
	188	+ List(HTTP_header) http_headers, // HTTP headers sent by the client
	189	+ Bool is_https,
	190	+ One -> String generate_trust_ticket // may be used against denial of
	191	+ // service attacks
	192	+ ).
	193	+
	194	+
	195	+
	196	+ Each site is described by a 'web site description', which is a datum of type
	197	+ 'Web_Site_Description'.
	198	+
	199	+public type Web_Site_Description:
	200	+ web_site_description(
	201	+ List(String) common_names,
	202	+ String site_directory,
	203	+ Redirections redirections,
	204	+ String charset,
	205	+ List(String) journal_extensions,
	206	+ List(String) journal_headers,
	207	+ String authorization_secret,
	208	+ List(MIME) known_mime_types,
	209	+ (String host_name,
	210	+ HTTP_Info http_info,
	211	+ List(Web_arg) lwa,
	212	+ Bool is_https) -> (//List(HTTP_header),
	213	+ Printable_tree) awp_handler,
	214	+ (HTTP_Info http_info,
	215	+ List(Web_arg) lwa) -> One before_send_file
	216	+ //Bool using_state_cookies,
	217	+ ).
	218	+
	219	+ The component 'common_names' is the list of names of the site, like for example
	220	+ "www.our-business.com". The reason why we have a list of common names instead of a
	221	+ single common name, is that it may be useful to have a common name like "192.168.0.1"
	222	+ for testing.
	223	+
	224	+ 'charset' is a string which will determine the character encoding to be used by the
	225	+ browser. Typically, this string is one of: "UTF-8", "ISO-8859-1", "Windows-1252",
	226	+ etc...
	227	+
	228	+ 'journal_extensions' is the list of URI extensions for which you want a log in the
	229	+ journal (and on the console). When a request arrives, and if the extension is a member
	230	+ of this list, a message is printed into the journal of the site including the date, the
	231	+ IP address of the client, the complete HTTP request line. The HTTP headers whose name
	232	+ is a member of 'journal_headers' are also printed in the journal. A reasonable minimum
	233	+ for these two components is:
	234	+
	235	+ [".awp"] for journal_extensions
	236	+ ["user-agent"] for journal_headers
	237	+
	238	+ 'authorization_secret' is a string which should just be unguessable. You may choose
	239	+ something like (but don't choose this one !):
	240	+
	241	+ "Hg8kJe42gCML9jNH-74"
	242	+
	243	+ i.e. a sequence of characters typed at random, long enough to be unguessable. This is
	244	+ used by the 'private download' mecanism, which is discussed later in this file.
	245	+
	246	+ The component 'awp_handler' is a function of type:
	247	+
	248	+ (String host_name,
	249	+ HTTP_Info http_info,
	250	+ List(Web_arg) web_args,
	251	+ Bool is_https) -> Printable_tree
	252	+
	253	+ ('Printable_tree' is a substitute for 'String' and is defined in
	254	+ 'tools/basis.anubis'). This function is the 'awp handler' for the site. When the URI
	255	+ ends by ".awp", this function is called, and the result (an HTML page) is sent to the
	256	+ client over the connection. The last operand to this function is a boolean which is
	257	+ 'true' when the requests arrives through the HTTPS channel, and 'false' when it arrives
	258	+ through the HTTP channel.
	259	+
	260	+
	261	+
	262	+
	263	+
	264	+
	265	+
	266	+ *** (5) Protection against denial of service attacks.
	267	+
	268	+ We need to protect our servers against 'denial of service' attacks. The attack may be
	269	+ send automatically from machines which are infested by viruses. In that case, our
	270	+ server is saturated of connections (all virtual machines at work), but nothing is
	271	+ comming on the connections. In order to avoid this problem, we propose the following:
	272	+
	273	+ (1) Limit the number of simultaneous connections (say to 100).
	274	+ (2) Close a connection if the request is not complete after say 10 seconds.
	275	+ (3) Close the connection if the request is bigger than a given size (normal requests
	276	+ are small except when there are uploaded files.
	277	+ (4) Close the connection during the sending of the answer if the client is waiting
	278	+ too much.
	279	+ (5) Record all IP addresses with which we have encountered one of the problems above.
	280	+ (6) Immediately close the connections if the IP address is in our list.
	281	+ (7) Remove an address from the list only after 5 minutes of inactivity of this
	282	+ address.
	283	+ (8) Maintain a list of reliable IP addresses.
	284	+
	285	+ Of course, all the above are approximative solutions which may in some circumstances
	286	+ become either cumbersome or also partially block the system. So, it is needed to have a
	287	+ set of dynamically modifiable parameters in order to master the behavior of this
	288	+ mecanism.
	289	+
	290	+
	291	+ Each dubious IP address is recorded together with its last activity time.
	292	+
	293	+public type DubiousIP:
	294	+ dubious_ip (Word32 address,
	295	+ Int last_activity).
	296	+
	297	+
	298	+public type DenialOfService:
	299	+ denial_of_service(Var(Int) max_connections,
	300	+ Var(Int) request_line_delay, // seconds
	301	+ Var(Int) headers_delay,
	302	+ Var(Int) answer_delay,
	303	+ Var(List(DubiousIP)) list_of_dubious,
	304	+ Var(List(Word32)) reliable_addresses).
	305	+
	306	+ The informations in this set of variables are stored serialized into the file
	307	+ 'my_anubis/web_sites/dos_info'. If this file does not exist a set if variables with
	308	+ default values is created. The values are saved on the disk each time they are
	309	+ modified.
	310	+
	311	+public define DenialOfService load_denial_of_service_info.
	312	+
	313	+
	314	+
	315	+ *** (6) Starting your HTTP and HTTPS servers.
	316	+
	317	+ When your web site descriptions are ready, you can start a pair of servers (a HTTP
	318	+ server and a HTTPS server) for serving your web sites. Notice that there are always
	319	+ two servers, regardless of the number of web sites, and that each web sites normally
	320	+ uses the two servers.
	321	+
	322	+
	323	+public define StartServerResult
	324	+ start_http_server
	325	+ (
	326	+ Word32 ip_address,
	327	+ Word32 http_port,
	328	+ List(Web_Site_Description) web_sites,
	329	+ DenialOfService dos
	330	+ ).
	331	+
	332	+public define StartServerResult
	333	+ start_https_server
	334	+ (
	335	+ Word32 ip_address,
	336	+ Word32 https_port,
	337	+ String certificate_common_name,
	338	+ List(Web_Site_Description) web_sites,
	339	+ DenialOfService dos
	340	+ ).
	341	+
	342	+ The first argument 'ip_address' is the IP address on which the servers listen. If you
	343	+ put 0, the servers listen on all adresses of the machine (which is useful if the
	344	+ machine has several network interfaces). Otherwise, use the function 'ip_address'
	345	+ defined in 'tools/basis.anubis' for composing a particular IP address.
	346	+
	347	+ The next arguments are the port numbers for HTTP and HTTPS. The usual values are 80 and
	348	+ 443, but you may have reasons to choose other values.
	349	+
	350	+ The next argument is the list of your web site descriptions. All the sites described in
	351	+ this list will be accessible on the server.
	352	+
	353	+ The argument 'dos' is a set of dynamic variables containing the informations for
	354	+ protecting the servers against denial of service attacks.
	355	+
	356	+
	357	+
	358	+
	359	+
	360	+
	361	+ *** (7) Private download.
	362	+
	363	+ It may happen that you want to propose private files for download. This means that such
	364	+ a file could be downloaded only by the authorized person, and should not be seen by any
	365	+ other one. This feature can be used only under HTTPS, not under HTTP.
	366	+
	367	+ The file may be located anywhere on the server. Hence, the file has a complete absolute
	368	+ path, like for example:
	369	+
	370	+ /home/georges/my_documents/my_text.pdf
	371	+
	372	+ which has nothing to do with the directories of the web server. Now, you may also want
	373	+ to show another path or simply just a name to the client, not the actual absolute path
	374	+ above, which may need to remain secret. So for example, the same file may appear to the
	375	+ client as:
	376	+
	377	+ informations.pdf
	378	+
	379	+ The page must provide a link with an authorization. The authorization is just a web
	380	+ argument, whose name is "zauth". The value of this web argument is computed by hashing
	381	+ some secret string (known only from the programmer of the web site) with the absolute
	382	+ path of the file. The HTTPS request will have the form:
	383	+
	384	+ GET /informations.pdf?zauth=d38161f5b4e87e2d46e06ff8b3e233be563794d1
	385	+
	386	+ The server will search for a file named
	387	+
	388	+ zd38161f5b4e87e2d46e06ff8b3e233be563794d1
	389	+
	390	+ (i.e. "z" concatenated with the value of the authorization) in the subdirectory
	391	+ 'private_download' of the site directory. This file contains the absolute path of the
	392	+ file, i.e:
	393	+
	394	+ /home/georges/my_documents/my_text.pdf
	395	+
	396	+ At that point, the server may hash the secret string and the absolute path together, to
	397	+ check if the client is authorized to download the file. If it is the case, it sends the
	398	+ file (the MIME type is declared as 'application/octet-stream' if it is not recognized).
	399	+ The file is sent under the visible name.
	400	+
	401	+ The server creates automatically the subdirectory 'private_download/' within the 'site
	402	+ directory' (for each web site) if it does not already exist. Files in this directory
	403	+ are deleted when they become too old (for example, after 3 days of life).
	404	+
	405	+ Here is the function for computing the value of the authorization, and for making the
	406	+ authorization file in 'private_download'.
	407	+
	408	+public define String
	409	+ make_authorization
	410	+ (
	411	+ String site_directory,
	412	+ String authorization_secret, // known only by the programmer of the web site
	413	+ String absolute_path // on server
	414	+ ).
	415	+
	416	+ See 'web/making_a_web_site.anubis' for the construction of the link for downloading.
	417	+
	418	+
	419	+
	420	+
	421	+
	422	+
	423	+
	424	+
	425	+ *** (8) About web argument names.
	426	+
	427	+ The server reserves the name "zauth" for the authorization in the private download
	428	+ mecanism. Also, if the name of a web arguments begins by "p" (like 'password'), it does
	429	+ not print the value of the web argument neither on the console or in the journal. A
	430	+ good politics is to prefix all web arguments by letters distinct from 'p' and 'z'. This
	431	+ method is used in 'web/making_a_web_site.anubis'. This will avoid clashes of names.
	432	+
	433	+
	434	+
	435	+
	436	+
	437	+
	438	+ *** (9) A web dispatcher.
	439	+
	440	+ For hosting several sites you may prefer another method which we now describe. We start
	441	+ a HTTP server on port 80 (or on another port). This server is called the
	442	+ ``dispatcher''. When a requests arrives, the dispatcher examines the ``host'' HTTP
	443	+ header, so that it gets the name of the requested host. Then it sends to the client a
	444	+ page like this one:
	445	+
	446	+ <html>
	447	+ <head>
	448	+ <meta http-equiv="Refresh" content="0;URL=...">
	449	+ </head>
	450	+ <body>
	451	+ </body>
	452	+ </html>
	453	+
	454	+ where the URL represented by '...' is the URL of the requested site. This URL may have
	455	+ the same IP address as the dispatcher, except that the port number is different. It may
	456	+ also have a different IP address.
	457	+
	458	+ The dispatcher uses the file 'my_anubis/web_sites/dispatcher.info'. This file contains
	459	+ a serialized datum of type 'List(DispatcherInfo)'.
	460	+
	461	+public type DispatcherInfo:
	462	+ site(String common_name,
	463	+ Word32 http_port).
	464	+
	465	+ The dispatcher does not write into this file. It reads it when it starts, and rereads
	466	+ it each time the date of last modification of the file changes, so that the dispatcher
	467	+ always has up to date data. The file may be managed (written and updated) by another
	468	+ program.
	469	+
	470	+ So, for each site, the dispatcher knows the common name (needed to recognize the 'host'
	471	+ HTTP header), and the pair (ip_address,port) used by the actual site for HTTP. The
	472	+ dispatcher does not worry about HTTPS. HTTPS must be managed by the actual site.
	473	+
	474	+ The dispatcher is started by:
	475	+
	476	+public define One
	477	+ start_web_dispatcher
	478	+ (
	479	+ Word32 ip_address, // address for listening (typically 0)
	480	+ Word32 port, // typically 80
	481	+ DenialOfService dos
	482	+ ).
	483	+
	484	+ A command line tool for managing the file 'my_anubis/web_sites/dispatcher.info' is also
	485	+ provided:
	486	+
	487	+ global define One
	488	+ manage_web_dispatcher
	489	+ (
	490	+ List(String) args
	491	+ ).
	492	+
	493	+
	494	+ *** (10) HTTP Errors
	495	+
	496	+public type HTTP_Status:
	497	+ http_continue, // 100
	498	+ http_switching_protocol, // 101
	499	+
	500	+ http_ok, // 200
	501	+ http_created, // 201
	502	+ http_accepted, // 202
	503	+ http_non_authoritative_info, // 203
	504	+ http_no_content, // 204
	505	+ http_reset_content, // 205
	506	+ http_partial_content, // 206
	507	+
	508	+ http_multiple_choices,
	509	+ http_moved_permanently(String location), // 301
	510	+ http_moved_temporarily(String location), // 302
	511	+ http_see_other(String location), // 303
	512	+ http_not_modified, // 304
	513	+ http_use_proxy(String location), // 305
	514	+ http_temporary_redirect(String location), // 307
	515	+
	516	+ http_bad_request, // 400
	517	+ http_unauthorized, // 401
	518	+ http_payment_required, // 402
	519	+ http_forbidden, // 403
	520	+ http_not_found, // 404
	521	+ http_method_not_allowed, // 405
	522	+ http_not_acceptable, // 406
	523	+ http_proxy_authentification_required, // 407
	524	+ http_request_timeout, // 408
	525	+ http_conflict, // 409
	526	+ http_gone, // 410
	527	+ http_length_required, // 411
	528	+ http_precondition_failed, // 412
	529	+ http_request_entity_too_large, // 413
	530	+ http_request_uri_too_long, // 414
	531	+ http_unsupported_media_type, // 415
	532	+ http_request_range_unsatisfiable, // 416
	533	+ http_expectation_failed, // 417
	534	+
	535	+ http_internal_server_error, // 500
	536	+ http_not_implemented, // 501
	537	+ http_bad_gateway, // 502
	538	+ http_service_unavailable, // 503
	539	+ http_gateway_timeout, // 504
	540	+ http_version_not_supported, // 505
	541	+
	542	+ http_error(Int /code/, String /message/).
	543	+
	544	+public define (String, List(HTTP_header))
	545	+ format
	546	+ (
	547	+ HTTP_Status status
	548	+ ).
	549	+
	550	+
	551	+
	552	+
	553	+
	554	+ --- That's all for the public part ! --------------------------------------------------
	555	+
	556	+define Maybe(String) get_host_header_value(List(HTTP_header) headers).
	557	+
	558	+define String
	559	+ __utime_to_string
	560	+ (
	561	+ UTime t
	562	+ ) =
	563	+ to_decimal(t.seconds) + "." + zero_pad_n(6, t.microseconds ) + "s".
	564	+
	565	+
	566	+variable UTime t0 = utime(0,0).
	567	+variable UTime t1 = utime(0,0).
	568	+
	569	+define One
	570	+ accumulate_t1
	571	+ (
	572	+ UTime start
	573	+ ) =
	574	+ with delta = (UTime)unow - start,
	575	+ t1 <- delta + *t1;
	576	+ unique.
	577	+
	578	+variable UTime t2 = utime(0,0).
	579	+
	580	+define One
	581	+ accumulate_t2
	582	+ (
	583	+ UTime start
	584	+ ) =
	585	+ with delta = (UTime)unow - start,
	586	+ t2 <- delta + *t2;
	587	+ unique.
	588	+
	589	+
	590	+public define One
	591	+ print_delta
	592	+ (
	593	+ String txt
	594	+ ) =
	595	+ println(__utime_to_string((UTime)unow - *t0) + " : " + txt).
	596	+
	597	+
	598	+ ----------------------------------- Table of Contents ---------------------------------
	599	+
	600	+ *** [1] Types which are private to this file.
	601	+
	602	+ *** [2] Tools.
	603	+ *** [2.1] Formating an error message.
	604	+ *** [2.2] Converting IP addresses.
	605	+ *** [2.3] Reading and unputting characters.
	606	+ *** [2.4] Reading and discarding characters.
	607	+ *** [2.5] Reading a character string.
	608	+ *** [2.6] Padding integers with zeros.
	609	+ *** [2.7] Converting web arguments to ASCII.
	610	+ *** [2.8] Server description.
	611	+
	612	+ *** [3] Managing the journal.
	613	+ *** [3.1] Naming journal files.
	614	+ *** [3.2] Formating HTTP headers.
	615	+ *** [3.3] Formating web arguments.
	616	+ *** [3.4] Formating the whole request.
	617	+ *** [3.5] Putting it in the journal file (and on the console).
	618	+
	619	+ *** [4] Reading the HTTP request.
	620	+ *** [4.1] Skipping leading blanks.
	621	+ *** [4.2] Reading a new line.
	622	+ *** [4.3] Reading a 'word'.
	623	+ *** [4.4] Separating the URI from the query string.
	624	+ *** [4.5] Reading the web arguments.
	625	+ *** [4.7] Reading the request line.
	626	+ *** [4.8] Reading the HTTP headers.
	627	+ *** [4.9] Getting the size of the request's body.
	628	+ *** [4.10] Reading the body of the request.
	629	+
	630	+ *** [5] Making the HTTP answer.
	631	+ *** [5.1] Avoiding illegal URIs.
	632	+ *** [5.2] Managing authorizations for downloading private files.
	633	+ *** [5.3] Recognizing MIME types.
	634	+ *** [5.4] Formating HTTP headers.
	635	+ *** [5.5] Sending a file.
	636	+ *** [5.6] Answering a www-url encoded request.
	637	+ *** [5.7] Answering a multipart/form-data encoded request.
	638	+ *** [5.7.1] Finding the boundary.
	639	+ *** [5.7.2] Reading attributes from a multipart entity.
	640	+ *** [5.7.3] Creating a temporary filename for an uploaded file.
	641	+ *** [5.7.4] Saving an uploaded file under a temporary filename.
	642	+ *** [5.7.5] Removing the path from a file name.
	643	+ *** [5.7.6] Reading a multipart entity.
	644	+ *** [5.8] Handling redirections.
	645	+ *** [5.9] Answering both sorts of requests.
	646	+
	647	+ *** [6] The HTTP/HTTPS servers.
	648	+ *** [6.1] The HTTP request handler.
	649	+ *** [6.2] Server's tasks.
	650	+ *** [6.3] Starting the HTTP/HTTPS servers.
	651	+
	652	+ *** [7] The web dispatcher.
	653	+ *** [7.1] The dispatcher server.
	654	+ *** [7.2] The dispatcher web site.
	655	+ *** [7.3] Managing the info file.
	656	+
	657	+ ---------------------------------------------------------------------------------------
	658	+
	659	+
	660	+
	661	+
	662	+read tools/basis.anubis
	663	+read tools/findstring.anubis
	664	+read tools/connections.anubis
	665	+
	666	+
	667	+
	668	+
	669	+
	670	+ *** [1] Types which are private to this file.
	671	+
	672	+ We use the following self-explanatory types.
	673	+
	674	+type Error:
	675	+ cannot_read_from_connection,
	676	+ not_get_or_post_request(String),
	677	+ end_of_line_expected,
	678	+ incorrect_content_length_value,
	679	+ colon_expected,
	680	+ timeout(Int).
	681	+
	682	+type HTTP_RequestType:
	683	+ get,
	684	+ post.
	685	+
	686	+type HTTP_RequestLine:
	687	+ request_line (HTTP_RequestType type,
	688	+ String uri,
	689	+ List(Web_arg) query_string).
	690	+
	691	+type EncodingType:
	692	+ www_url,
	693	+ multipart_form_data.
	694	+
	695	+type BufferedConnection:
	696	+ buffered_connection(Connection conn,
	697	+ Var(ByteArray) buffer,
	698	+ Var(Int) read_pos).
	699	+
	700	+
	701	+
	702	+ *** [2] Tools.
	703	+
	704	+ *** [2.1] Formating an error message.
	705	+
	706	+ The next function formats an error message.
	707	+
	708	+define String
	709	+ format
	710	+ (
	711	+ Error msg
	712	+ ) =
	713	+ if msg is
	714	+ {
	715	+ cannot_read_from_connection then
	716	+ "Cannot read from connection.\n",
	717	+ not_get_or_post_request(s) then
	718	+ "The request did not begin by 'GET' or 'POST': "+s+".\n",
	719	+ end_of_line_expected then
	720	+ "End of line expected.\n",
	721	+ incorrect_content_length_value then
	722	+ "Incorrect value for HTTP header 'Content-Length'.\n",
	723	+ colon_expected then
	724	+ "':' was expected.\n",
	725	+ timeout(n) then
	726	+ //"time out: "+n+"\n"
	727	+ //"time out.\n"
	728	+ ""
	729	+ }.
	730	+
	731	+
	732	+
	733	+
	734	+
	735	+
	736	+ *** [2.2] Converting IP addresses.
	737	+
	738	+ We need two conversion functions for IP addresses:
	739	+
	740	+ (Word8,Word8,Word8,Word8) --> Word32 ip_address
	741	+ Word32 --> String ip_addr_to_string
	742	+
	743	+ These conversions are defined in 'tools/basis.anubis'.
	744	+
	745	+
	746	+
	747	+
	748	+
	749	+
	750	+
	751	+
	752	+ *** [2.3] Reading and unputting characters.
	753	+
	754	+ We need a mecanism for unputting several characters (actually at least 3). This is
	755	+ because when reading the client connection, we must sometimes go ahead several
	756	+ characters, and virtually put them back into the connection, so that they can be
	757	+ reread. Of course, we do not send them back to the client. We store them in a list
	758	+ (hold by the variable 'unput_chars'), and we manage this list, so that characters may
	759	+ be virtually put back in the connection (this is called 'unputting').
	760	+
	761	+variable List(Word8) unput_chars = [].
	762	+
	763	+ The most recently read one is the head of list. Fortunately, this variable is private
	764	+ to this virtual machine (hence to this client).
	765	+
	766	+
	767	+define One
	768	+ unput // unputting a character (add it in front of the list)
	769	+ (
	770	+ Word8 character
	771	+ ) =
	772	+ unput_chars <- (List(Word8))[character . *unput_chars].
	773	+
	774	+
	775	+
	776	+define One record_dubious_IP(Word32 addr,DenialOfService dos).
	777	+
	778	+variable Int sttm = 0. // contains the start time for this connection.
	779	+
	780	+define Result(Error,Word8)
	781	+ record_dubious_connection
	782	+ (
	783	+ Connection conn,
	784	+ Int dead_line,
	785	+ DenialOfService dos,
	786	+ ) =
	787	+ if remote_IP_address_and_port(conn) is (addr,port) then
	788	+ record_dubious_IP(addr,dos);
	789	+ print("Recording IP address "+ip_addr_to_string(addr)+
	790	+ " as dubious after "+(dead_line-*sttm)+" seconds. Total: "+
	791	+ length(*list_of_dubious(dos))+"\n");
	792	+ error(timeout(dead_line)).
	793	+
	794	+define String
	795	+ pid
	796	+ =
	797	+ "[" + virtual_machine_id + "] ".
	798	+
	799	+
	800	+define One
	801	+ put
	802	+ (
	803	+ ByteArray source,
	804	+ ByteArray dest,
	805	+ Int position,
	806	+ Int i
	807	+ ) =
	808	+ if nth(i,source) is
	809	+ {
	810	+ failure then unique,
	811	+ success(b) then if put(dest,position,b) is
	812	+ {
	813	+ failure then unique,
	814	+ success(_) then put(source,dest,position+1,i+1)
	815	+ }
	816	+ }.
	817	+
	818	+define ReadResult
	819	+ read_from_connexion
	820	+ (
	821	+ BufferedConnection connection,
	822	+ Int size,
	823	+ Int time_out,
	824	+ ByteArray result_buffer,
	825	+ Int position
	826	+ ) =
	827	+ //println(pid + "read_from_connexion(" + size + ")");
	828	+
	829	+ if connection.read_pos < length(connection.buffer) then
	830	+ //println(pid + " reading from buffer (size = " + length(connection.buffer) + ", pos = " + connection.read_pos);
	831	+ //with t1_tmp = (UTime) unow,
	832	+ with result = extract(connection.buffer, connection.read_pos, *connection.read_pos + size),
	833	+ size_read = length(result),
	834	+ put(result,result_buffer,position,0);
	835	+ connection.read_pos <- *connection.read_pos + size_read;
	836	+ //accumulate_t1(t1_tmp);
	837	+ if size > size_read then
	838	+ //println("Wanted " + size + ", read only " + size_read);
	839	+
	840	+ terminal read_from_connexion(connection, size - size_read, time_out, result_buffer,position+size_read)
	841	+// {
	842	+// error then error,
	843	+// timeout then ok(result),
	844	+// ok(ba) then ok(result + ba)
	845	+// }
	846	+ else
	847	+ ok(result_buffer)
	848	+ else
	849	+ //if unow > dead_line then record_dubious_connection(connection,dead_line,dos) else
	850	+ if read(connection.conn, 16384, time_out) is // the connection is closed after 10 minutes of inactivity
	851	+ {
	852	+ error then println(pid + "read failed)"); error,
	853	+ timeout then timeout,
	854	+ ok(ba) then
	855	+// println(pid + "ba = " + length(ba));
	856	+ connection.buffer <- ba;
	857	+ connection.read_pos <- 0;
	858	+ //println(pid + "rb = " + length(*read_buffer));
	859	+
	860	+ terminal read_from_connexion(connection, size, time_out, result_buffer,position)
	861	+ }.
	862	+
	863	+define Result(Error,Word8)
	864	+ next_char // reading a character (check the list first, and read on the connection
	865	+ // only when the list is empty).
	866	+ (
	867	+ BufferedConnection connection,
	868	+ Int dead_line,
	869	+ DenialOfService dos
	870	+ ) =
	871	+ //with t2_tmp = (UTime) now,
	872	+ if *unput_chars is
	873	+ {
	874	+ [ ] then
	875	+ // ///////////////////
	876	+ // Buffered reading
	877	+ //if unow > dead_line then record_dubious_connection(connection,dead_line,dos) else
	878	+ if nth(connection.read_pos, connection.buffer) is
	879	+ {
	880	+ failure then
	881	+ if read_from_connexion(connection,1,600, constant_byte_array(1,0),0) is // the connection is closed after 10 minutes of inactivity
	882	+ {
	883	+ error then /accumulate_t2(t2_tmp);/ error(cannot_read_from_connection),
	884	+ timeout then /accumulate_t2(t2_tmp);/ error(timeout(600)),
	885	+ //record_dubious_connection(connection,dead_line,dos),
	886	+ ok(ba) then if nth(0,ba) is
	887	+ {
	888	+ failure then /accumulate_t2(t2_tmp);/ error(cannot_read_from_connection),
	889	+ success(c) then
	890	+ //println("-" + pid + "read [" + implode([c]) + "]\t");
	891	+ //accumulate_t2(t2_tmp);
	892	+ ok(c)
	893	+ }
	894	+ },
	895	+ success(c) then
	896	+ connection.read_pos <- *connection.read_pos + 1;
	897	+ //accumulate_t2(t2_tmp);
	898	+ ok(c)
	899	+ },
	900	+
	901	+ // ///////////////////
	902	+ // standard reading
	903	+// if read(connection.conn, 1, 600) is // the connection is closed after 10 minutes of inactivity
	904	+// {
	905	+// error then accumulate_t2(t2_tmp); println(pid + "read failed)"); error(cannot_read_from_connection),
	906	+// timeout then accumulate_t2(t2_tmp); error(timeout(600)),
	907	+// ok(ba) then if nth(0,ba) is
	908	+// {
	909	+// failure then accumulate_t2(t2_tmp); error(cannot_read_from_connection),
	910	+// success(c) then accumulate_t2(t2_tmp);
	911	+// ok(c)
	912	+// }
	913	+// },
	914	+
	915	+ [h . t] then
	916	+ unput_chars <- t; //accumulate_t2(t2_tmp);
	917	+ ok(h)
	918	+ }.
	919	+
	920	+
	921	+
	922	+
	923	+
	924	+
	925	+ *** [2.4] Reading and discarding characters.
	926	+
	927	+ The next function reads the specified number of bytes (this is the same as
	928	+ 'characters') from the connection and discards them. This is used for discarding CR LF
	929	+ just before the body of a request.
	930	+
	931	+define Result(Error,One)
	932	+ read_and_ignore
	933	+ (
	934	+ BufferedConnection connection, // to client
	935	+ Int dead_line,
	936	+ Int number_of_characters, // number of characters to read and ignore
	937	+ DenialOfService dos
	938	+ ) =
	939	+ if number_of_characters =< 0 then ok(unique) else
	940	+ if next_char(connection, dead_line, dos) is
	941	+ {
	942	+ error(msg) then error(msg),
	943	+ ok(c) then read_and_ignore(connection,dead_line,number_of_characters-1,dos)
	944	+ }.
	945	+
	946	+
	947	+
	948	+
	949	+
	950	+
	951	+
	952	+ *** [2.5] Reading a character string.
	953	+
	954	+ Sometimes values of HTTP attributes or web args are presented in the form of double
	955	+ quoted strings. The next function handles the reading of such things. The leading
	956	+ double quote is already read in. We must read subsequent characters until the next non
	957	+ backslashed double quote.
	958	+
	959	+define Result(Error,String)
	960	+ read_string
	961	+ (
	962	+ BufferedConnection connection, // connection with the client
	963	+ Int dead_line,
	964	+ List(Word8) so_far, // characters read so far (in reverse order)
	965	+ DenialOfService dos
	966	+ ) =
	967	+ if next_char(connection, dead_line,dos) is
	968	+ {
	969	+ error(msg) then error(msg),
	970	+ ok(c) then
	971	+ if c = '\\'
	972	+ then if next_char(connection,dead_line,dos) is
	973	+ {
	974	+ error(msg) then error(msg),
	975	+ ok(d) then
	976	+ if d = '\"'
	977	+ then read_string(connection,dead_line,['\"' . so_far],dos)
	978	+ else read_string(connection,dead_line,[d, c . so_far],dos)
	979	+ }
	980	+ else if c = '\"'
	981	+ then ok(implode(reverse(so_far)))
	982	+ else read_string(connection,dead_line,[c . so_far],dos)
	983	+ }.
	984	+
	985	+
	986	+
	987	+
	988	+
	989	+
	990	+
	991	+
	992	+
	993	+
	994	+
	995	+
	996	+ *** [2.7] Converting web arguments to ASCII.
	997	+
	998	+ The function 'web_to_ascii' gets a character string and replaces web encoding by normal
	999	+ ASCII encoding. This amounts to replacing:
	1000	+
	1001	+ + by blank
	1002	+ %xx by the character whose ASCII code is xx in hexadecimal
	1003	+
	1004	+ Note: We assume that '9' < 'A' (which is the case for ASCII code).
	1005	+
	1006	+
	1007	+
	1008	+define Word8
	1009	+ web_decode
	1010	+ (
	1011	+ Word8 x1,
	1012	+ Word8 x2
	1013	+ ) =
	1014	+ with n1 = if x1 +=< '9' then (x1 - '0') else if x1 +=< 'F' then (x1 - 'A' + 10) else (x1 - 'a' + 10),
	1015	+ n2 = if x2 +=< '9' then (x2 - '0') else if x2 +=< 'F' then (x2 - 'A' + 10) else (x2 - 'a' + 10),
	1016	+ (n1 << 4) + n2.
	1017	+
	1018	+
	1019	+
	1020	+define String
	1021	+ web_to_ascii
	1022	+ (
	1023	+ String web_string,
	1024	+ Int n, // current position in web_string
	1025	+ List(Word8) so_far
	1026	+ ) =
	1027	+ if nth(n,web_string) is
	1028	+ {
	1029	+ failure then implode(reverse(so_far)),
	1030	+ success(c) then
	1031	+ if c = '+'
	1032	+ then web_to_ascii(web_string,n+1,[' ' . so_far])
	1033	+ else if c = '%'
	1034	+ then if nth(n+1,web_string) is
	1035	+ {
	1036	+ failure then implode(reverse(so_far)),
	1037	+ success(x1) then if nth(n+2,web_string) is
	1038	+ {
	1039	+ failure then implode(reverse(so_far)),
	1040	+ success(x2) then web_to_ascii(web_string,n+3,[web_decode(x1,x2) . so_far])
	1041	+ }
	1042	+ }
	1043	+ else web_to_ascii(web_string,n+1,[c . so_far])
	1044	+ }.
	1045	+
	1046	+
	1047	+
	1048	+
	1049	+
	1050	+
	1051	+
	1052	+
	1053	+ *** [3] Managing the journal.
	1054	+
	1055	+ Concurrently working machines should not try to access the same file at the same
	1056	+ time. This problem may be solved by using the 'protect' mecanism.
	1057	+
	1058	+
	1059	+
	1060	+ *** [3.1] Naming journal files.
	1061	+
	1062	+ Since journal messages are rather prolific, we should have at least one file per
	1063	+ hour. Hence, the name of a journal file must be constructed from the current year,
	1064	+ month, day and hour. For example, it may be:
	1065	+
	1066	+ 2003_03_12_19
	1067	+
	1068	+ (this is for the journal of 7 PM to 8 PM, 2003/mar/12).
	1069	+
	1070	+define String
	1071	+ make_current_journal_file_name
	1072	+ =
	1073	+ if convert_time(now) is date_and_time(y,m,d,h,_,_,_,_,_) then
	1074	+ to_decimal(y)+"_"+
	1075	+ zero_pad_n(2,m)+"_"+
	1076	+ zero_pad_n(2,d)+"_"+
	1077	+ zero_pad_n(2,h).
	1078	+
	1079	+
	1080	+
	1081	+
	1082	+
	1083	+
	1084	+
	1085	+ *** [3.2] Formating HTTP headers.
	1086	+
	1087	+ HTTP headers may be shown on the console or written in the journal. The function below
	1088	+ formats a list of HTTP headers.
	1089	+
	1090	+define String
	1091	+ show_format
	1092	+ (
	1093	+ Web_Site_Description desc,
	1094	+ List(HTTP_header) headers,
	1095	+ ) =
	1096	+ if headers is
	1097	+ {
	1098	+ [ ] then "",
	1099	+ [h . t] then if h is http_header(name,value) then
	1100	+ if member(journal_headers(desc),name)
	1101	+ then " \| "+name+": "+value+"\n"+show_format(desc,t)
	1102	+ else show_format(desc,t)
	1103	+ }.
	1104	+
	1105	+
	1106	+
	1107	+
	1108	+
	1109	+
	1110	+ *** [3.3] Formating web arguments.
	1111	+
	1112	+ The same thing for web arguments.
	1113	+
	1114	+define String
	1115	+ show_format
	1116	+ (
	1117	+ List(Web_arg) lwa
	1118	+ ) =
	1119	+ if lwa is
	1120	+ {
	1121	+ [ ] then "",
	1122	+ [h . t] then if h is
	1123	+ {
	1124	+ web_arg(n,v) then
	1125	+ " \| "+n+"="+(if nth(0,n) = success('p') then "<not shown>" else v)+"\n"+show_format(t),
	1126	+ upload(n,fn,tfn) then
	1127	+ " \| "+n+"="+fn+" (uploaded as '"+tfn+"')\n"+show_format(t)
	1128	+ }
	1129	+ }.
	1130	+
	1131	+
	1132	+
	1133	+
	1134	+
	1135	+
	1136	+ *** [3.4] Formating the whole request.
	1137	+
	1138	+ It is cheap to transform month numbers into abbreviated month names. This enhances the
	1139	+ readability of the journal.
	1140	+
	1141	+define String
	1142	+ format_month
	1143	+ (
	1144	+ Int m
	1145	+ ) =
	1146	+ if m = 1 then "jan" else
	1147	+ if m = 2 then "feb" else
	1148	+ if m = 3 then "mar" else
	1149	+ if m = 4 then "apr" else
	1150	+ if m = 5 then "may" else
	1151	+ if m = 6 then "jun" else
	1152	+ if m = 7 then "jul" else
	1153	+ if m = 8 then "aug" else
	1154	+ if m = 9 then "sep" else
	1155	+ if m = 10 then "oct" else
	1156	+ if m = 11 then "nov" else
	1157	+ if m = 12 then "dec" else
	1158	+ "???".
	1159	+
	1160	+
	1161	+ Below we format a whole HTTP request. This may give this (actually, it depends on how
	1162	+ you defined the values of 'journal_headers' and 'journal_extensions'):
	1163	+
	1164	+ [3] 2003/mar/10 10:06:57 from 123.456.123.456: /homepage.awp
	1165	+ \| host: www.the-best-one.com
	1166	+ \| user-agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0
	1167	+
	1168	+ The leading number between brackets is the number of the virtual machine which served
	1169	+ the URI.
	1170	+
	1171	+define String
	1172	+ format_request
	1173	+ (
	1174	+ Web_Site_Description desc,
	1175	+ Connection client_connection,
	1176	+ HTTP_RequestLine request_line,
	1177	+ List(HTTP_header) headers,
	1178	+ List(Web_arg) web_args
	1179	+ ) =
	1180	+ with dt = convert_time(now),
	1181	+ if remote_IP_address_and_port(client_connection) is (addr,port) then
	1182	+ to_decimal(year(dt))+"/"+format_month(month(dt))+"/"+zero_pad_n(2,day(dt))+" "+
	1183	+ zero_pad_n(2,hour(dt))+":"+zero_pad_n(2,minute(dt))+":"+zero_pad_n(2,second(dt))+
	1184	+ " from "+ip_addr_to_string(addr)+
	1185	+ ": "+uri(request_line)+"\n"+
	1186	+ show_format(desc,headers)+
	1187	+ show_format(web_args).
	1188	+
	1189	+
	1190	+
	1191	+
	1192	+
	1193	+
	1194	+
	1195	+ *** [3.5] Putting it in the journal file (and on the console).
	1196	+
	1197	+ We must not forget to 'protect' this operation, so that the messages of two machines
	1198	+ (working for the same site) will not be mixed together.
	1199	+
	1200	+define One
	1201	+ log_journal_msg
	1202	+ (
	1203	+ Web_Site_Description desc,
	1204	+ String msg,
	1205	+ ) =
	1206	+ with ba_msg = to_byte_array("["+virtual_machine_id+"] "+msg+"\n"),
	1207	+ protect
	1208	+ (
	1209	+ if file(site_directory(desc)+"/journal/"+make_current_journal_file_name,append) is
	1210	+ {
	1211	+ failure then unique,
	1212	+ success(journal_file) then
	1213	+ forget(reliable_write(file(journal_file),ba_msg))
	1214	+ };
	1215	+ forget(reliable_write(file(stdout),ba_msg))
	1216	+ ).
	1217	+
	1218	+
	1219	+
	1220	+
	1221	+
	1222	+
	1223	+
	1224	+ *** [4] Reading the HTTP request.
	1225	+
	1226	+
	1227	+ *** [4.1] Skipping leading blanks.
	1228	+
	1229	+ One of the peculiarities of HTTP is that the characters 13 (carriage return) and 10
	1230	+ (line feed) followed by either a space (32) or a tab (9), is considered as a blank not
	1231	+ containing any new line. 'skip_http_blanks' must skip all blanks characters until the
	1232	+ first non blank character, which should not be read in. Obviously, because of the above
	1233	+ peculiarity, we need at least 3 characters of lookahead to do this. In other words, we
	1234	+ must be able to unput at least 3 characters (hopefully we are).
	1235	+
	1236	+ Strictly blanks characters are 'space' and 'tab'.
	1237	+
	1238	+define Bool
	1239	+ is_strict_blank
	1240	+ (
	1241	+ Word8 c
	1242	+ ) =
	1243	+ if c = ' ' then true else c = '\t'.
	1244	+
	1245	+
	1246	+ On the contrary, blanks include 13 and 10.
	1247	+
	1248	+define Bool
	1249	+ is_blank
	1250	+ (
	1251	+ Word8 c
	1252	+ ) =
	1253	+ if c = ' ' then true else
	1254	+ if c = '\t' then true else
	1255	+ if c = 13 then true else
	1256	+ c = 10.
	1257	+
	1258	+
	1259	+ Skipping HTTP blanks.
	1260	+
	1261	+define Result(Error,One)
	1262	+ skip_http_blanks
	1263	+ (
	1264	+ BufferedConnection connection,
	1265	+ Int dead_line,
	1266	+ DenialOfService dos
	1267	+ ) =
	1268	+ if next_char(connection,dead_line,dos) is
	1269	+ {
	1270	+ error(msg) then error(msg),
	1271	+ ok(c) then
	1272	+ if is_strict_blank(c)
	1273	+ then skip_http_blanks(connection,dead_line,dos)
	1274	+ else if c = 13
	1275	+ then if next_char(connection,dead_line,dos) is
	1276	+ {
	1277	+ error(msg) then error(msg), // (unput(c); ok(unique)),
	1278	+ ok(d) then
	1279	+ if d = 10
	1280	+ then if next_char(connection,dead_line,dos) is
	1281	+ {
	1282	+ error(msg) then error(msg), // (unput(d); unput(c); ok(unique)),
	1283	+ ok(e) then
	1284	+ if is_strict_blank(e)
	1285	+ then skip_http_blanks(connection,dead_line,dos)
	1286	+ else (unput(e); unput(d); unput(c); ok(unique))
	1287	+ }
	1288	+ else (unput(d); unput(c); ok(unique))
	1289	+ }
	1290	+ else (unput(c); ok(unique))
	1291	+ }.
	1292	+
	1293	+
	1294	+
	1295	+
	1296	+
	1297	+
	1298	+
	1299	+
	1300	+ *** [4.2] Reading a new line.
	1301	+
	1302	+ Normally in HTTP a new line is the sequence 13 10 (carriage return line feed), not
	1303	+ followed by a space or tabulator. If it is followed by a space or tabulator, the three
	1304	+ characters are considered blanks, and no new line has been read. Before trying to read
	1305	+ a new line, we first skip leading spaces and tabs. Then we try to read 13 and 10, and
	1306	+ we read another character. if this character is space or tab, we consider we have read
	1307	+ only blanks and we continue reading in order to find our new line. Otherwise, we unput
	1308	+ this character (which may be for example the first character of the name of the next
	1309	+ header), and answer that we have seen a new line.
	1310	+
	1311	+ Warning: we must not use this function for reading the last pair (13,10) before the
	1312	+ beginning of the body, because if the body is empty, there is no character to read
	1313	+ after this pair, so that the server could wait for a character which will never
	1314	+ come. This is the reason for 'read_and_ignore' above, which is used precisely for
	1315	+ reading that last (13,10) pair.
	1316	+
	1317	+define Result(Error,One)
	1318	+ read_new_line
	1319	+ (
	1320	+ BufferedConnection connection,
	1321	+ Int dead_line,
	1322	+ DenialOfService dos
	1323	+ ) =
	1324	+ if skip_http_blanks(connection,dead_line,dos) is
	1325	+ {
	1326	+ error(msg) then error(msg),
	1327	+ ok(_) then
	1328	+ if next_char(connection,dead_line,dos) is
	1329	+ {
	1330	+ error(msg) then error(msg),
	1331	+ ok(c) then
	1332	+ if c = 13
	1333	+ then if next_char(connection,dead_line,dos) is
	1334	+ {
	1335	+ error(msg) then error(msg),
	1336	+ ok(d) then
	1337	+ if d = 10
	1338	+ then ok(unique)
	1339	+ else (unput(d);
	1340	+ unput(c);
	1341	+ error(end_of_line_expected))
	1342	+ }
	1343	+ else (unput(c);
	1344	+ error(end_of_line_expected))
	1345	+ }}.
	1346	+
	1347	+
	1348	+
	1349	+
	1350	+
	1351	+
	1352	+
	1353	+
	1354	+ *** [4.3] Reading a 'word'.
	1355	+
	1356	+ A 'word' is a sequence of characters which begins either by a double quote or not by a
	1357	+ double quote. (However, any leading blanks are read in and ignored. This is
	1358	+ accomplished by 'skip_http_blanks'.) If it begins by a double quote, it is read like a
	1359	+ string, i.e. it ends at the next (non backslashed) double quote. Otherwise, it is
	1360	+ right delimited by any character which may be considered as 'blank'. If the word is
	1361	+ double quoted, the closing double quote is read in. On the contrary, if the word is not
	1362	+ double quoted, the right delimiting blank character is not read in (it is 'unput' back
	1363	+ into the connection), and may be read in again. This is needed because carriage return
	1364	+ or line feed which are 'blank', also have a meaning in HTTP.
	1365	+
	1366	+define Result(Error,String)
	1367	+ read_word_aux
	1368	+ (
	1369	+ BufferedConnection connection,
	1370	+ Int dead_line,
	1371	+ List(Word8) so_far,
	1372	+ DenialOfService dos
	1373	+ ) =
	1374	+ if next_char(connection,dead_line,dos) is
	1375	+ {
	1376	+ error(msg) then error(msg),
	1377	+ ok(c) then
	1378	+ if is_blank(c)
	1379	+ then (unput(c);
	1380	+ ok(implode(reverse(so_far))))
	1381	+ else read_word_aux(connection,dead_line,[c . so_far],dos)
	1382	+ }.
	1383	+
	1384	+define Result(Error,String)
	1385	+ read_word
	1386	+ (
	1387	+ BufferedConnection connection,
	1388	+ Int dead_line,
	1389	+ DenialOfService dos
	1390	+ ) =
	1391	+ if skip_http_blanks(connection,dead_line,dos) is
	1392	+ {
	1393	+ error(msg) then error(msg),
	1394	+ ok(_) then
	1395	+ if next_char(connection,dead_line,dos) is
	1396	+ {
	1397	+ error(msg) then error(msg),
	1398	+ ok(c) then
	1399	+ if c = '\"'
	1400	+ then read_string(connection,dead_line,[],dos)
	1401	+ else read_word_aux(connection,dead_line,[c],dos)
	1402	+ }
	1403	+ }.
	1404	+
	1405	+
	1406	+
	1407	+
	1408	+
	1409	+
	1410	+
	1411	+
	1412	+ *** [4.4] Separating the URI from the query string.
	1413	+
	1414	+ A 'query string' may be postfixed to the URI, just after a question mark. For example,
	1415	+ the client may send the following request:
	1416	+
	1417	+ GET /catalog.awp?item=3&color=blue
	1418	+
	1419	+ We separate this into an URI: "/catalog.awp" and the string: "item=3&color=blue" which
	1420	+ will be later transformed into the list:
	1421	+
	1422	+ [web_arg("item","3"),web_arg("color","blue")]
	1423	+
	1424	+
	1425	+define (String,String)
	1426	+ separate_uri_from_query_string
	1427	+ (
	1428	+ String uri_and_query_string,
	1429	+ Int n
	1430	+ ) =
	1431	+ if nth(n,uri_and_query_string) is
	1432	+ {
	1433	+ failure then (uri_and_query_string,""),
	1434	+ success(c) then
	1435	+ if c = '?'
	1436	+ then (substr(uri_and_query_string,0,n),
	1437	+ substr(uri_and_query_string,n+1,length(uri_and_query_string)-(n+1)))
	1438	+ else separate_uri_from_query_string(uri_and_query_string,n+1)
	1439	+ }.
	1440	+
	1441	+
	1442	+
	1443	+
	1444	+
	1445	+
	1446	+
	1447	+
	1448	+
	1449	+ *** [4.5] Reading the web arguments.
	1450	+
	1451	+ HTTP/HTTPS requests are sent in one of two formats:
	1452	+
	1453	+ (1) www-url encoded
	1454	+ (2) multipart/form-data encoded
	1455	+
	1456	+ The first one is the normal (historical) way of encoding. The second one is required
	1457	+ for uploading files. A server which is supposed to accept upload of files must handle
	1458	+ both formats. The first thing to do is to decide the format of the request. This is
	1459	+ easily done by examining the HTTP headers. If we find the header:
	1460	+
	1461	+ Content-Type: multipart/form-data
	1462	+
	1463	+ the request is multipart/form-data encoded. Otherwise, it is 'www-url' encoded. We
	1464	+ first consider 'www-url' encoded requests.
	1465	+
	1466	+ For a 'www-url' encoded request, the web argument are either in the query string or in
	1467	+ the body of the request, or both. The format is the same for both:
	1468	+
	1469	+ name=value&name=value&...
	1470	+
	1471	+ However, we may also have
	1472	+
	1473	+ name
	1474	+ name=
	1475	+ name=&...
	1476	+ name&...
	1477	+
	1478	+ i.e. some parts may be missing. Hence, we must be careful.
	1479	+
	1480	+ Furthermore, web arguments must be translated from web to ASCII when www-url encoded.
	1481	+
	1482	+define Bool
	1483	+ is_ampersand_or_equal
	1484	+ (
	1485	+ Word8 c
	1486	+ ) =
	1487	+ if c = '&' then true else c = '='.
	1488	+
	1489	+
	1490	+
	1491	+ The function 'read_name_or_value' reads the string 's' starting at position 'n' until
	1492	+ either the end of the string or the first '&' or '='.
	1493	+
	1494	+define String
	1495	+ read_name_or_value
	1496	+ (
	1497	+ String s,
	1498	+ Int start,
	1499	+ Int i
	1500	+ ) =
	1501	+ if nth(i,s) is
	1502	+ {
	1503	+ failure then substr(s,start,i - start),
	1504	+ success(c) then
	1505	+ if is_ampersand_or_equal(c)
	1506	+ then substr(s,start,i-start) // the separator is not included
	1507	+ else read_name_or_value(s,start,i+1)
	1508	+ }.
	1509	+
	1510	+
	1511	+define List(Web_arg)
	1512	+ read_www_url_encoded_web_args
	1513	+ (
	1514	+ String s,
	1515	+ Int start,
	1516	+ ) =
	1517	+ with first = read_name_or_value(s,start,start),
	1518	+ if first = ""
	1519	+ then []
	1520	+ else with i = start+length(first),
	1521	+ if nth(i,s) is
	1522	+ {
	1523	+ failure then [web_arg(first,"")],
	1524	+ success(c) then
	1525	+ if c = '&'
	1526	+ then [web_arg(first,"") . read_www_url_encoded_web_args(s,i+1)]
	1527	+ else if c = '='
	1528	+ then with second1 = read_name_or_value(s,i+1,i+1),
	1529	+ // print("\""+second1+"\"\n");
	1530	+ with second = web_to_ascii(second1,0,[]),
	1531	+ [web_arg(first,second) . read_www_url_encoded_web_args(s,i+length(second1)+2)]
	1532	+ else print("** ALERT ** badly formatted argument [" + s + "]!!!\n");
	1533	+ []
	1534	+ }.
	1535	+
	1536	+
	1537	+
	1538	+
	1539	+
	1540	+ *** [4.7] Reading the request line.
	1541	+
	1542	+ 'read_request_line' reads three words and a new line from the connection. It tries to
	1543	+ recognize "get" or "post" in the first word, separates the URI from the query string in
	1544	+ the second word, transforms the query string into a list of 'Web_arg', and finally
	1545	+ returns a datum of type 'HTTP_RequestLine' if no error arose.
	1546	+
	1547	+
	1548	+define Result(Error,HTTP_RequestType)
	1549	+ identify_get_or_post
	1550	+ (
	1551	+ String s
	1552	+ ) =
	1553	+ with ls = to_lower(s),
	1554	+ if ls = "get" then ok(get) else
	1555	+ if ls = "post" then ok(post) else
	1556	+ error(not_get_or_post_request(ls)).
	1557	+
	1558	+define Result(Error,HTTP_RequestLine)
	1559	+ read_request_line
	1560	+ (
	1561	+ BufferedConnection connection,
	1562	+ Int dead_line,
	1563	+ DenialOfService dos
	1564	+ ) =
	1565	+ if read_word(connection,dead_line,dos) is
	1566	+ {
	1567	+ error(msg) then error(msg),
	1568	+ ok(get_or_post) then if read_word(connection,dead_line,dos) is
	1569	+ {
	1570	+ error(msg) then error(msg),
	1571	+ ok(uri_and_query_string) then if read_word(connection,dead_line,dos) is
	1572	+ {
	1573	+ error(msg) then error(msg),
	1574	+ ok(http_version) then if read_new_line(connection,dead_line,dos) is
	1575	+ {
	1576	+ error(msg) then error(msg),
	1577	+ ok(_) then if separate_uri_from_query_string(uri_and_query_string,0) is
	1578	+ (uri,query_string) then if identify_get_or_post(get_or_post) is
	1579	+ {
	1580	+ error(msg) then error(msg),
	1581	+ ok(request_type) then
	1582	+ ok(request_line(request_type, web_to_ascii(uri, 0, []), read_www_url_encoded_web_args(query_string,0)))
	1583	+ }
	1584	+ }
	1585	+ }
	1586	+ }
	1587	+ }.
	1588	+
	1589	+
	1590	+
	1591	+
	1592	+
	1593	+
	1594	+
	1595	+ *** [4.8] Reading the HTTP headers.
	1596	+
	1597	+ Each header is made of a name (containing only letters, the underscore, digits and the
	1598	+ minus sign), a colon, a value, and a new line. The first empty line ends the headers.
	1599	+
	1600	+
	1601	+ The next function tests characters acceptable in a header name.
	1602	+
	1603	+define Bool
	1604	+ is_header_name_char
	1605	+ (
	1606	+ Word8 c
	1607	+ ) =
	1608	+ if ('a' +=< c & c +=< 'z') then true else
	1609	+ if ('A' +=< c & c +=< 'Z') then true else
	1610	+ if ('0' +=< c & c +=< '9') then true else
	1611	+ if c = '-' then true else
	1612	+ c = '_'.
	1613	+
	1614	+define Result(Error,String)
	1615	+ read_header_name
	1616	+ (
	1617	+ BufferedConnection connection,
	1618	+ Int dead_line,
	1619	+ List(Word8) so_far,
	1620	+ DenialOfService dos
	1621	+ ) =
	1622	+ if next_char(connection,dead_line,dos) is
	1623	+ {
	1624	+ error(msg) then error(msg),
	1625	+ ok(c) then
	1626	+ if is_header_name_char(c)
	1627	+ then read_header_name(connection,dead_line,[to_lower(c) . so_far],dos)
	1628	+ else unput(c); ok(implode(reverse(so_far)))
	1629	+ }.
	1630	+
	1631	+define Result(Error,One)
	1632	+ skip_colon
	1633	+ (
	1634	+ BufferedConnection connection,
	1635	+ Int dead_line,
	1636	+ DenialOfService dos
	1637	+ ) =
	1638	+ if skip_http_blanks(connection,dead_line,dos) is
	1639	+ {
	1640	+ error(msg) then error(msg),
	1641	+ ok(_) then
	1642	+ if next_char(connection,dead_line,dos) is
	1643	+ {
	1644	+ error(msg) then error(msg),
	1645	+ ok(c) then
	1646	+ if c = ':'
	1647	+ then ok(unique)
	1648	+ else error(colon_expected)
	1649	+ }}.
	1650	+
	1651	+
	1652	+define Result(Error,String)
	1653	+ read_header_value
	1654	+ (
	1655	+ BufferedConnection connection,
	1656	+ Int dead_line,
	1657	+ List(Word8) so_far,
	1658	+ DenialOfService dos
	1659	+ ) =
	1660	+ if next_char(connection,dead_line,dos) is
	1661	+ {
	1662	+ error(msg) then error(msg),
	1663	+ ok(c) then
	1664	+ if c = 13
	1665	+ then if next_char(connection,dead_line,dos) is
	1666	+ {
	1667	+ error(msg) then error(msg),
	1668	+ ok(d) then
	1669	+ if d = 10
	1670	+ then if next_char(connection,dead_line,dos) is
	1671	+ {
	1672	+ error(msg) then error(msg),
	1673	+ ok(e) then
	1674	+ if is_strict_blank(e)
	1675	+ then read_header_value(connection,dead_line,[e . so_far],dos)
	1676	+ else (unput(e); ok(implode(reverse(so_far))))
	1677	+ }
	1678	+ else read_header_value(connection,dead_line,[d, c . so_far],dos)
	1679	+ }
	1680	+ else read_header_value(connection,dead_line,[c . so_far],dos)
	1681	+ }.
	1682	+
	1683	+
	1684	+ Reading a single header.
	1685	+
	1686	+define Result(Error,Maybe(HTTP_header))
	1687	+ read_header
	1688	+ (
	1689	+ BufferedConnection connection,
	1690	+ Int dead_line,
	1691	+ DenialOfService dos
	1692	+ ) =
	1693	+ if read_header_name(connection,dead_line,[],dos) is
	1694	+ {
	1695	+ error(msg) then error(msg),
	1696	+ ok(name) then
	1697	+ if name = "" then
	1698	+ if read_and_ignore(connection,dead_line,2,dos) /* 13 and 10 */ is
	1699	+ {
	1700	+ error(msg) then error(msg),
	1701	+ ok(_) then // this is the blank line
	1702	+ ok(failure) // end of headers
	1703	+ }
	1704	+ else if skip_colon(connection,dead_line,dos) is
	1705	+ {
	1706	+ error(msg) then error(msg),
	1707	+ ok(_) then if skip_http_blanks(connection,dead_line,dos) is
	1708	+ {
	1709	+ error(msg) then error(msg),
	1710	+ ok(_) then if read_header_value(connection,dead_line,[],dos) is
	1711	+ {
	1712	+ error(msg) then error(msg),
	1713	+ ok(value) then
	1714	+ ok(success(http_header(name,value)))
	1715	+ }
	1716	+ }
	1717	+ }
	1718	+ }.
	1719	+
	1720	+
	1721	+
	1722	+ Reading all the headers.
	1723	+
	1724	+define Result(Error,List(HTTP_header))
	1725	+ read_http_headers
	1726	+ (
	1727	+ BufferedConnection connection,
	1728	+ Int dead_line,
	1729	+ DenialOfService dos
	1730	+ ) =
	1731	+ if read_header(connection,dead_line,dos) is
	1732	+ {
	1733	+ error(msg) then error(msg),
	1734	+ ok(mbh) then if mbh is
	1735	+ {
	1736	+ failure then ok([ ]),
	1737	+ success(header) then
	1738	+ if read_http_headers(connection,dead_line,dos) is
	1739	+ {
	1740	+ error(msg) then error(msg),
	1741	+ ok(others) then ok([header . others])
	1742	+ }
	1743	+ }
	1744	+ }.
	1745	+
	1746	+
	1747	+
	1748	+
	1749	+
	1750	+
	1751	+
	1752	+ *** [4.9] Getting the size of the request's body.
	1753	+
	1754	+ The size of the body of the request is given under the 'Content-Length' header. If this
	1755	+ header is not present, the size is assumed to be zero.
	1756	+
	1757	+define Result(Error,Int)
	1758	+ get_body_size
	1759	+ (
	1760	+ List(HTTP_header) headers
	1761	+ ) =
	1762	+ if headers is
	1763	+ {
	1764	+ [ ] then ok(0),
	1765	+ [h . t] then if h is http_header(name,value) then
	1766	+ if name = "content-length"
	1767	+ then if decimal_scan(value) is
	1768	+ {
	1769	+ failure then error(incorrect_content_length_value),
	1770	+ success(n) then ok(n)
	1771	+ }
	1772	+ else get_body_size(t)
	1773	+ }.
	1774	+
	1775	+
	1776	+
	1777	+
	1778	+
	1779	+
	1780	+
	1781	+
	1782	+
	1783	+
	1784	+ *** [4.10] Reading the body of the request.
	1785	+
	1786	+ The body of the request may be very big (it contains uploaded files, if any). We read
	1787	+ it using the primitive 'read', which returns the number of bytes read, which may be
	1788	+ less than the number of bytes we wanted to read. This is not an error, but simply due
	1789	+ to the fact the buffer associated with the connection in the Linux (or MS-Windows)
	1790	+ kernel has a limited size. Hence, we must read bytes again until we have read the
	1791	+ required number of bytes. However, if the number of bytes read is zero, the connection
	1792	+ may be broken. In that case, we must not try to read indefinitely. On the contrary, we
	1793	+ make at most 10 retries, with a small sleeping time between any two of them.
	1794	+
	1795	+define Result(Error,ByteArray)
	1796	+ read_http_body
	1797	+ (
	1798	+ BufferedConnection connection,
	1799	+ Int body_size,
	1800	+ ByteArray so_far, // when calling this function, 'so_far' is the empty byte array
	1801	+ Int retries // this function is called with retries = 10
	1802	+ ) =
	1803	+ if body_size = 0 then ok(constant_byte_array(0,0)) else
	1804	+ if retries =< 0 then error(cannot_read_from_connection) else
	1805	+ if read_from_connexion(connection,body_size,60,constant_byte_array(body_size,0),0) is
	1806	+ {
	1807	+ error then error(cannot_read_from_connection),
	1808	+ timeout then error(timeout(60)),
	1809	+ ok(new_bytes) then with
	1810	+ ba = so_far + new_bytes, // contains all the bytes read so far
	1811	+ nr = length(ba), // total read since the beginning
	1812	+ nn = length(new_bytes), // number of bytes just read
	1813	+ if nr < body_size // must read more bytes
	1814	+ then if nn > 0 // if connection seems to work
	1815	+ then read_http_body(connection,body_size,ba,1000) // continue reading
	1816	+ else sleep(100); // otherwise, sleep 1/10 of second
	1817	+ read_http_body(connection,body_size,ba, // and retry reading
	1818	+ retries-1) // but no more than 10 times
	1819	+ else ok(ba) // required number of bytes has been read
	1820	+ }.
	1821	+
	1822	+
	1823	+ Note: During sleeping, 'anbexec' runs other machines. Actually, calling 'sleep', even
	1824	+ for one millisecond, is some way of giving up explicitly, so that other virtual
	1825	+ machines may work.
	1826	+
	1827	+
	1828	+
	1829	+
	1830	+
	1831	+
	1832	+
	1833	+
	1834	+
	1835	+
	1836	+
	1837	+
	1838	+ *** [5] Making the HTTP answer.
	1839	+
	1840	+ At that point we have read the request line, the headers and the body of the
	1841	+ request, and we must decide what to do.
	1842	+
	1843	+ Actually, we can do one of the following:
	1844	+
	1845	+ - send a file,
	1846	+ - execute 'tickets_and_web_page' in case of an ".awp" URI.
	1847	+
	1848	+ The uploaded file (which are in the body of the request) are saved into temporary files
	1849	+ below.
	1850	+
	1851	+
	1852	+
	1853	+
	1854	+
	1855	+ *** [5.1] Avoiding illegal URIs.
	1856	+
	1857	+ For security reasons, we must avoid illegal URIs, for example those which may climb up
	1858	+ in the file hierarchy. First we accept only few characters in URIs.
	1859	+
	1860	+define Bool
	1861	+ is_legal_uri_char
	1862	+ (
	1863	+ Word8 c
	1864	+ ) =
	1865	+ if ('a' +=< c & c +=< 'z') then true else // accept 'a' to 'z'
	1866	+ if ('A' +=< c & c +=< 'Z') then true else // accept 'A' to 'Z'
	1867	+ if ('0' +=< c & c +=< '9') then true else // accept '0' to '9'
	1868	+ if c = '.' then true else // accept '.' '-' '/' and '_'
	1869	+ if c = '-' then true else
	1870	+ if c = '/' then true else
	1871	+ c = '_'.
	1872	+
	1873	+ We do not accept ~ which is some way of climbing. Of course, we cannot disallow single
	1874	+ dots, which are most often present in legal URIs, but we must avoid double dots ..
	1875	+ which mean 'climb up'.
	1876	+
	1877	+define Bool
	1878	+ is_illegal_uri
	1879	+ (
	1880	+ String uri,
	1881	+ Int n
	1882	+ ) =
	1883	+ if nth(n,uri) is
	1884	+ {
	1885	+ failure then false,
	1886	+ success(c) then
	1887	+ if c = '.' // first dot
	1888	+ then if nth(n+1,uri) is
	1889	+ {
	1890	+ failure then false,
	1891	+ success(d) then
	1892	+ if d = '.' // second dot
	1893	+ then true
	1894	+ else is_illegal_uri(uri,n+1)
	1895	+ }
	1896	+ else is_illegal_uri(uri,n+1)
	1897	+ }.
	1898	+
	1899	+
	1900	+
	1901	+
	1902	+
	1903	+
	1904	+ *** [5.2] Managing authorizations for downloading private files.
	1905	+
	1906	+ Computing the authorization and making the authorization file (containing the absolute
	1907	+ path of the file on the server).
	1908	+
	1909	+
	1910	+define String
	1911	+ compute_authorization
	1912	+ (
	1913	+ String authorization_secret,
	1914	+ String absolute_path
	1915	+ ) =
	1916	+ to_ascii(sha1((authorization_secret,
	1917	+ absolute_path))).
	1918	+
	1919	+
	1920	+public define String
	1921	+ make_authorization
	1922	+ (
	1923	+ String site_directory,
	1924	+ String authorization_secret,
	1925	+ String absolute_path
	1926	+ ) =
	1927	+ with private_download_dir = site_directory+"/private_download",
	1928	+ auth = compute_authorization(authorization_secret,
	1929	+ absolute_path),
	1930	+ forget(save(absolute_path,
	1931	+ private_download_dir+"/z"+auth));
	1932	+ auth.
	1933	+
	1934	+
	1935	+ The function 'send_file' defined below handles the recognition of authorizations.
	1936	+
	1937	+
	1938	+
	1939	+
	1940	+
	1941	+ *** [5.3] Recognizing MIME types.
	1942	+
	1943	+ The extension of the (redirected) URI must be either ".awp" or recognized as associated
	1944	+ to a MIME type. Otherwise, the server will not send the file. This is for security, but
	1945	+ also because, we must generate a 'Content-Type' header in the answer, with the right
	1946	+ MIME type.
	1947	+
	1948	+define String
	1949	+ get_uri_extension_aux
	1950	+ (
	1951	+ String uri,
	1952	+ Int n // used for searching backwards
	1953	+ ) =
	1954	+ if nth(n,uri) is
	1955	+ {
	1956	+ failure then "",
	1957	+ success(c) then
	1958	+ if c = '.' then substr(uri,n,length(uri)-n)
	1959	+ else if c = '/' then ""
	1960	+ else get_uri_extension_aux(uri,n-1)
	1961	+ }.
	1962	+
	1963	+public define String
	1964	+ get_uri_extension
	1965	+ (
	1966	+ String uri
	1967	+ ) =
	1968	+ get_uri_extension_aux(uri,
	1969	+ length(uri)-1). // search starts at the right end
	1970	+
	1971	+public define Bool
	1972	+ contains_no_case
	1973	+ (
	1974	+ List(String) l,
	1975	+ String val
	1976	+ ) =
	1977	+ if l is
	1978	+ {
	1979	+ [] then false,
	1980	+ [h . t] then
	1981	+ if insensitive_equal(h, val) then true
	1982	+ else contains_no_case(t, val)
	1983	+ }.
	1984	+
	1985	+
	1986	+define Maybe(MIME)
	1987	+ recognize_mime_type_from_ext
	1988	+ (
	1989	+ String ext,
	1990	+ List(MIME) l
	1991	+ ) =
	1992	+ if l is
	1993	+ {
	1994	+ [ ] then success(mime("application", "octet-stream", [])), // failure,
	1995	+ [h . t] then if h is mime(type, subtype, extensions) then
	1996	+ if contains_no_case(extensions, ext)
	1997	+ then success(h)
	1998	+ else recognize_mime_type_from_ext(ext,t)
	1999	+ }.
	2000	+
	2001	+define Maybe(MIME)
	2002	+ recognize_mime_type_from_uri
	2003	+ (
	2004	+ Web_Site_Description desc,
	2005	+ String uri
	2006	+ ) =
	2007	+ recognize_mime_type_from_ext(get_uri_extension(uri),known_mime_types(desc)).
	2008	+
	2009	+
	2010	+
	2011	+
	2012	+
	2013	+
	2014	+
	2015	+
	2016	+ *** [5.4] Formating HTTP headers.
	2017	+
	2018	+ This is the formating for sending to the client (hence, it has nothing to do with the
	2019	+ component 'journal_headers' in the web site description).
	2020	+
	2021	+public define Printable_tree
	2022	+ format_headers
	2023	+ (
	2024	+ List(HTTP_header) headers
	2025	+ ) =
	2026	+ if headers is
	2027	+ {
	2028	+ [ ] then [ ],
	2029	+ [h . t] then if h is http_header(name,value) then
	2030	+ [name,": ",value,crlf . format_headers(t)]
	2031	+ }.
	2032	+
	2033	+
	2034	+
	2035	+define String
	2036	+ month_abrv
	2037	+ (
	2038	+ Date_and_Time d
	2039	+ ) =
	2040	+ if d.month = 1 then "Jan"
	2041	+ else if d.month = 2 then "Feb"
	2042	+ else if d.month = 3 then "Mar"
	2043	+ else if d.month = 4 then "Apr"
	2044	+ else if d.month = 5 then "May"
	2045	+ else if d.month = 6 then "Jun"
	2046	+ else if d.month = 7 then "Jul"
	2047	+ else if d.month = 8 then "Aug"
	2048	+ else if d.month = 9 then "Sep"
	2049	+ else if d.month = 10 then "Oct"
	2050	+ else if d.month = 11 then "Nov"
	2051	+ else if d.month = 12 then "Dec"
	2052	+ else
	2053	+ println("Bad month value [" + d.month + "] on Date_and_Time");
	2054	+ "XXX".
	2055	+
	2056	+define String
	2057	+ weekday_abrv
	2058	+ (
	2059	+ Date_and_Time d
	2060	+ ) =
	2061	+ if d.week_day = 0 then "Sun"
	2062	+ else if d.week_day = 1 then "Mon"
	2063	+ else if d.week_day = 2 then "Tue"
	2064	+ else if d.week_day = 3 then "Wed"
	2065	+ else if d.week_day = 4 then "Thu"
	2066	+ else if d.week_day = 5 then "Fri"
	2067	+ else if d.week_day = 6 then "Sat"
	2068	+ else
	2069	+ println("Bad weekday value [" + d.week_day + "] on Date_and_Time");
	2070	+ "XXX".
	2071	+
	2072	+/**
	2073	+ * Format a date with the followin format : "Mon, 23 Jul 2007 11:33:43 GMT"
	2074	+ * Currently, this function can't output a GMT time, but only local time.
	2075	+ * So the final GMT is totally fake, but needed by protocol.
	2076	+ */
	2077	+public define String
	2078	+ format_http_date
	2079	+ (
	2080	+ Date_and_Time d
	2081	+ ) =
	2082	+ weekday_abrv(d) + ", " + zero_pad_n(2,day(d)) + " " + month_abrv(d) + " " + year(d)
	2083	+ + " " + zero_pad_n(2,hour(d)) + ":" + zero_pad_n(2,minute(d)) + ":" + zero_pad_n(2,second(d)) + " GMT".
	2084	+
	2085	+/**
	2086	+ * Same as previous format_http_date() function, but with seconds count from the UNIX epoch as input.
	2087	+ */
	2088	+public define String
	2089	+ format_http_date
	2090	+ (
	2091	+ Int date
	2092	+ ) =
	2093	+ format_http_date(convert_time(date)).
	2094	+
	2095	+
	2096	+ *** [5.5] Sending a file.
	2097	+
	2098	+ We send 2 headers 'Content-Type' and 'Content-Length'.
	2099	+
	2100	+define List(HTTP_header)
	2101	+ headers_for_send_file
	2102	+ (
	2103	+ MIME mime_type,
	2104	+ Int size,
	2105	+ String etag,
	2106	+ Maybe(FileTimes) mb_ftimes,
	2107	+ ) =
	2108	+ with headers = (List(HTTP_header))
	2109	+ [
	2110	+ http_header("Content-Type", to_String(mime_type)),
	2111	+ http_header("Etag", etag),
	2112	+ http_header("Content-Length",to_decimal(size)),
	2113	+ ],
	2114	+ if mb_ftimes is
	2115	+ {
	2116	+ failure then headers,
	2117	+ success(ftimes) then [http_header("Last-Modified", format_http_date(to_Int(ftimes.last_modified))) . headers]
	2118	+ }
	2119	+ .
	2120	+
	2121	+
	2122	+
	2123	+ Sending the body of the answer (i.e. the file itself).
	2124	+
	2125	+define One
	2126	+ send_file_body
	2127	+ (
	2128	+ Web_Site_Description desc,
	2129	+ Connection connection, // connection with the client
	2130	+ Connection file, // file to be sent already opened
	2131	+ Int size, // size of file
	2132	+ Int sent, // bytes already sent
	2133	+ String filename // name of file
	2134	+ ) =
	2135	+ if sent >= size then unique else
	2136	+ if read(file,min(16384,size-sent),60) is
	2137	+ {
	2138	+ error then log_journal_msg(desc,"Cannot read from file '"+filename+"'.\n"),
	2139	+ timeout then log_journal_msg(desc,"Cannot read from file timeoput'"+filename+"'.\n"),
	2140	+ ok(ba) then
	2141	+ with nr = length(ba), // get the number of bytes read
	2142	+ if reliable_write(connection, ba) is
	2143	+ {
	2144	+ failure then log_journal_msg(desc,"Cannot write into connection delirering '"+filename+"' (sent="+sent+"; size="+size+"; current="+nr+").\n"),
	2145	+ success(nw) then
	2146	+ send_file_body(desc,connection,file,size,sent+nw,filename)
	2147	+ }
	2148	+ }.
	2149	+
	2150	+
	2151	+define String
	2152	+ compute_etag
	2153	+ (
	2154	+ String filename,
	2155	+ Maybe(FileTimes) mb_ftimes,
	2156	+ Int size,
	2157	+ ) =
	2158	+ if mb_ftimes is
	2159	+ {
	2160	+ failure then println("Warning: no file times for '" + filename + "', etag won't be very accurate."); to_ascii(sha1((filename, size))),
	2161	+ success(ftimes) then to_ascii(md5((filename, ftimes, size)))
	2162	+ }.
	2163	+
	2164	+define Bool
	2165	+ are_same_etag
	2166	+ (
	2167	+ Maybe(String) input_etag,
	2168	+ String current_etag
	2169	+ ) =
	2170	+ if input_etag is
	2171	+ {
	2172	+ failure then false,
	2173	+ success(etag) then etag = current_etag
	2174	+ }.
	2175	+
	2176	+ Sending the answer line, the headers and the body.
	2177	+
	2178	+define One
	2179	+ send_file
	2180	+ (
	2181	+ Web_Site_Description desc,
	2182	+ Connection connection,
	2183	+ List(HTTP_header) input_headers,
	2184	+ List(HTTP_header) headers,
	2185	+ Int size,
	2186	+ Connection file,
	2187	+ String filename,
	2188	+ String full_path,
	2189	+ MIME mime_type,
	2190	+ One -> One action_before_send_file
	2191	+ ) =
	2192	+ action_before_send_file(unique);
	2193	+ with input_etag = http_header_value(input_headers, "If-None-Match"),
	2194	+ mb_ftimes = get_file_times(full_path),
	2195	+ current_etag = compute_etag(full_path, mb_ftimes, size),
	2196	+ if are_same_etag(input_etag, current_etag) is
	2197	+ {
	2198	+ false then
	2199	+ forget(reliable_write(connection,to_byte_array("HTTP/1.1 200 OK"+crlf)));
	2200	+ forget(reliable_write(connection,[format_headers(headers + headers_for_send_file(mime_type, size, current_etag, mb_ftimes)) , crlf]));
	2201	+ //forget(copy_file_to_Connection(file, connection, size)),
	2202	+ send_file_body(desc,connection,file,size,0,filename),
	2203	+ true then
	2204	+ forget(reliable_write(connection,to_byte_array("HTTP/1.1 304 Not Modified"+crlf)));
	2205	+ forget(reliable_write(connection,[format_headers([http_header("Etag", current_etag) . headers]) , crlf]))
	2206	+ //send_file_body(desc,connection,file,size,0,filename)
	2207	+ }.
	2208	+
	2209	+
	2210	+
	2211	+ Checking if a connection is under SSL.
	2212	+
	2213	+define Bool
	2214	+ is_SSL
	2215	+ (
	2216	+ Connection c
	2217	+ ) =
	2218	+ if c is
	2219	+ {
	2220	+ file_r(_) then false,
	2221	+ file_w(_) then false,
	2222	+ file_rw(_) then false,
	2223	+ tcp(_) then false,
	2224	+ ssl(_) then true
	2225	+ }.
	2226	+
	2227	+
	2228	+
	2229	+ Before opening and sending a file, we check the MIME type. It must be recognized,
	2230	+ except if there is a valid authorization for private download.
	2231	+
	2232	+define One
	2233	+ send_file
	2234	+ (
	2235	+ Web_Site_Description desc,
	2236	+ Connection connection,
	2237	+ String uri,
	2238	+ List(HTTP_header) input_headers,
	2239	+ List(HTTP_header) output_headers,
	2240	+ Maybe(String) mbauthorization,
	2241	+ One -> One action_before_send_file
	2242	+ ) =
	2243	+ if mbauthorization is
	2244	+ {
	2245	+ //--- file without authorization: take it from public ---
	2246	+ failure then if recognize_mime_type_from_uri(desc,uri) is
	2247	+ {
	2248	+ failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"),
	2249	+ success(mime_type) then
	2250	+ with path = site_directory(desc)+"/public"+uri,
	2251	+ if (Maybe(RStream))file(path, read) is
	2252	+ {
	2253	+ failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"),
	2254	+ success(f) then with size = file_size(f),
	2255	+ send_file(desc,
	2256	+ connection,
	2257	+ input_headers,
	2258	+ output_headers,
	2259	+ size,
	2260	+ file(f),
	2261	+ uri,
	2262	+ path,
	2263	+ mime_type,
	2264	+ action_before_send_file)
	2265	+ }
	2266	+ },
	2267	+
	2268	+ //--- file with authorization: apply 'private download' mecanism ---
	2269	+ success(authorization) then
	2270	+ with private_download_dir = site_directory(desc)+"/private_download",
	2271	+ if (RetrieveResult(String))retrieve(private_download_dir+"/z"+authorization)
	2272	+ is ok(absolute_path)
	2273	+ then (
	2274	+ with new_hash = compute_authorization(authorization_secret(desc),
	2275	+ absolute_path),
	2276	+ if (Maybe(RStream))file(absolute_path, read) is
	2277	+ {
	2278	+ failure then log_journal_msg(desc,"Cannot find file '"+absolute_path+"'.\n"),
	2279	+ success(f) then with size = file_size(f),
	2280	+ mime_type = if recognize_mime_type_from_uri(desc,uri) is
	2281	+ {
	2282	+ failure then mime("application", "octet-stream", []),
	2283	+ success(mime_type) then mime_type
	2284	+ },
	2285	+ send_file(desc,
	2286	+ connection,
	2287	+ input_headers,
	2288	+ output_headers,
	2289	+ size,
	2290	+ file(f),
	2291	+ uri,
	2292	+ absolute_path,
	2293	+ mime_type,
	2294	+ action_before_send_file)
	2295	+ }
	2296	+ )
	2297	+ else log_journal_msg(desc,"Cannot find or read authorization file.\n")
	2298	+ }.
	2299	+
	2300	+
	2301	+
	2302	+
	2303	+
	2304	+
	2305	+
	2306	+
	2307	+ *** [5.6] Answering a www-url encoded request.
	2308	+
	2309	+ Standard headers are for answering ".awp" requests.
	2310	+
	2311	+public define List(HTTP_header)
	2312	+ standard_headers
	2313	+ =
	2314	+ [
	2315	+ http_header("Date", format_http_date(now)),
	2316	+ http_header("Server", "Anubis Embedded Server v" + major_version_number + "." + minor_version_number),
	2317	+ http_header("Connection", "close"),
	2318	+ ].
	2319	+
	2320	+public define List(HTTP_header)
	2321	+ standard_headers_for
	2322	+ (
	2323	+ String mime_type,
	2324	+ Int answer_body_size,
	2325	+ Maybe(String) mb_charset,
	2326	+ ) =
	2327	+ [
	2328	+ http_header("Content-Type", mime_type + if mb_charset is success(charset) then "; charset="+charset else ""),
	2329	+ http_header("Content-length", to_decimal(answer_body_size))
	2330	+ ].
	2331	+
	2332	+public define List(HTTP_header)
	2333	+ file_attached_header
	2334	+ (
	2335	+ String filename
	2336	+ ) =
	2337	+ [
	2338	+ http_header("Content-Disposition", "attachment; filename=\"" + filename +"\"")
	2339	+ ].
	2340	+
	2341	+
	2342	+define One
	2343	+ www_url_answer
	2344	+ (
	2345	+ String host_name,
	2346	+ Web_Site_Description desc,
	2347	+ Connection connection, // with the client
	2348	+ Word32 ip_addr, // of the client
	2349	+ HTTP_RequestLine request_line,
	2350	+ List(HTTP_header) headers,
	2351	+ ByteArray body,
	2352	+ One -> String generate_tt // trust ticket generation
	2353	+ ) =
	2354	+ with all_web_args = query_string(request_line) +
	2355	+ read_www_url_encoded_web_args(to_string(body),0),
	2356	+ uri = uri(request_line),
	2357	+ ext = get_uri_extension(uri),
	2358	+ http_inf = http_info(ip_addr, host_name, uri, headers, is_SSL(connection), generate_tt),
	2359	+ (if member(journal_extensions(desc),ext)
	2360	+ then log_journal_msg(desc,
	2361	+ format_request(desc,connection,request_line,headers,all_web_args))
	2362	+ else unique);
	2363	+ if is_illegal_uri(uri,0)
	2364	+ then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
	2365	+ else (if (ext = ".awp" \| ext = "")
	2366	+ then (with answer_headers_body = awp_handler(desc)(host_name,
	2367	+ http_inf,
	2368	+ all_web_args,
	2369	+ is_SSL(connection)),
	2370	+ //print_delta("After page generation");
	2371	+ forget(reliable_write(connection, answer_headers_body))
	2372	+ //print_delta("After sending page")
	2373	+ )
	2374	+ else (send_file(desc,
	2375	+ connection,
	2376	+ uri,
	2377	+ headers,
	2378	+ standard_headers,
	2379	+ if web_arg_value(all_web_args,"zauth") is
	2380	+ {
	2381	+ not_found then failure,
	2382	+ found(v) then success(v)
	2383	+ },
	2384	+ (One u) \|-> before_send_file(desc)(http_inf, all_web_args))
	2385	+ //print_delta("After sending file")
	2386	+ )).
	2387	+
	2388	+
	2389	+
	2390	+
	2391	+
	2392	+
	2393	+
	2394	+ *** [5.7] Answering a multipart/form-data encoded request.
	2395	+
	2396	+ In order to support upload of files, we must be able to read web arguments which are
	2397	+ encoded in a multipart/form-data body. The first thing to do is to find the
	2398	+ boundary. The boundary is a special string which delimits the various parts of the
	2399	+ 'multipart' body. It is found within the value of the 'Content-Type' HTTP header, as
	2400	+ the value of the 'boundary' attribute.
	2401	+
	2402	+
	2403	+
	2404	+
	2405	+
	2406	+ *** [5.7.1] Finding the boundary.
	2407	+
	2408	+ Hence, we just have to find the string 'boundary=' within the value of the
	2409	+ 'Content-Type' header, and read the value of the boundary from there.
	2410	+
	2411	+define Bool
	2412	+ delimits_boundary
	2413	+ (
	2414	+ Word8 c
	2415	+ ) =
	2416	+ if c = ' ' then true else
	2417	+ if c = 13 then true else
	2418	+ if c = 10 then true else
	2419	+ if c = 0 then true else
	2420	+ if c = ',' then true else
	2421	+ c = ';'.
	2422	+
	2423	+
	2424	+define Maybe(String)
	2425	+ get_boundary_value_3
	2426	+ (
	2427	+ String s,
	2428	+ Int i,
	2429	+ List(Word8) so_far
	2430	+ ) =
	2431	+ if nth(i,s) is
	2432	+ {
	2433	+ failure then success(implode(reverse(so_far))),
	2434	+ success(c) then
	2435	+ if delimits_boundary(c)
	2436	+ then success(implode(reverse(so_far)))
	2437	+ else get_boundary_value_3(s,i+1,[c . so_far])
	2438	+ }.
	2439	+
	2440	+
	2441	+
	2442	+define Maybe(String)
	2443	+ get_boundary_value_2
	2444	+ (
	2445	+ String s,
	2446	+ Int i,
	2447	+ ) =
	2448	+ if nth(i,s) is
	2449	+ {
	2450	+ failure then failure,
	2451	+ success(c) then
	2452	+ if is_blank(c)
	2453	+ then get_boundary_value_2(s,i+1)
	2454	+ else get_boundary_value_3(s,i+1,[c])
	2455	+ }.
	2456	+
	2457	+define Maybe(String)
	2458	+ get_boundary_value_1
	2459	+ (
	2460	+ String s, // string into which we must find '= ...'
	2461	+ Int i // position of start of search
	2462	+ ) =
	2463	+ if nth(i,s) is
	2464	+ {
	2465	+ failure then failure,
	2466	+ success(c) then
	2467	+ if is_blank(c)
	2468	+ then get_boundary_value_1(s,i+1)
	2469	+ else if c = '='
	2470	+ then get_boundary_value_2(s,i+1)
	2471	+ else failure
	2472	+ }.
	2473	+
	2474	+
	2475	+define Maybe(String)
	2476	+ get_boundary
	2477	+ (
	2478	+ String content_type_header_value
	2479	+ ) =
	2480	+ if find("boundary",content_type_header_value,0) is
	2481	+ {
	2482	+ failure then failure,
	2483	+ success(n) then // 'boundary' has been found at position n
	2484	+ get_boundary_value_1(content_type_header_value,n+8)
	2485	+ }.
	2486	+
	2487	+define Maybe(String)
	2488	+ get_boundary
	2489	+ (
	2490	+ List(HTTP_header) headers
	2491	+ ) =
	2492	+ if headers is
	2493	+ {
	2494	+ [ ] then failure,
	2495	+ [h . t] then if h is http_header(name,value) then
	2496	+ if name = "content-type"
	2497	+ then get_boundary(value)
	2498	+ else get_boundary(t)
	2499	+ }.
	2500	+
	2501	+
	2502	+
	2503	+
	2504	+
	2505	+
	2506	+
	2507	+
	2508	+ *** [5.7.2] Reading attributes from a multipart entity.
	2509	+
	2510	+ Entities in a multipart/form-data body are separated by instances of the string:
	2511	+
	2512	+ --bbbbb
	2513	+
	2514	+ where bbbbb is the boundary computed above. Actually, the body has the form:
	2515	+
	2516	+ --bbbbb
	2517	+ <entity 1>
	2518	+ --bbbbb
	2519	+ <entity 2>
	2520	+ --bbbbb
	2521	+ ...
	2522	+ --bbbbb
	2523	+ <last entity>
	2524	+ --bbbbb
	2525	+
	2526	+
	2527	+ We have to extract an entity which is in the body between offsets 'start' and 'end'
	2528	+ (computed when boundaries have been localized). The entity itself is made of two parts:
	2529	+ headers and body. The body is separated from the headers by a blank line. This blank
	2530	+ line (a double crlf) marks the beginning of the body of the entity. Within the headers
	2531	+ of the entity, we look for a 'Content-Disposition' header, which should look like this:
	2532	+
	2533	+ Content-Disposition: form-data; name="..."; filename="..." crlf
	2534	+
	2535	+ We are just interested in the name and the file name. Hence we first search
	2536	+ 'Content-Disposition', then we search 'name' and read the value, and we do the same for
	2537	+ 'filename'.
	2538	+
	2539	+ If the 'filename' attribute is not present, the web arg is an ordinary one, otherwise,
	2540	+ it is an uploaded file.
	2541	+
	2542	+
	2543	+ Below is a variant of 'find' (see 'tools/findstring.anubis'), with an extra 'end'
	2544	+ argument.
	2545	+
	2546	+define Maybe(Int)
	2547	+ find
	2548	+ (
	2549	+ String what,
	2550	+ ByteArray where,
	2551	+ Int start,
	2552	+ Int end
	2553	+ ) =
	2554	+ if find(to_byte_array(what),where,start) is
	2555	+ {
	2556	+ failure then failure,
	2557	+ success(n) then
	2558	+ if n+length(what) >= end
	2559	+ then failure
	2560	+ else success(n)
	2561	+ }.
	2562	+
	2563	+
	2564	+define String
	2565	+ read_attribute_value
	2566	+ (
	2567	+ ByteArray where,
	2568	+ Int start,
	2569	+ Int end,
	2570	+ List(Word8) so_far
	2571	+ ) =
	2572	+ if start >= end then implode(reverse(so_far)) else
	2573	+ if nth(start,where) is
	2574	+ {
	2575	+ failure then implode(reverse(so_far)),
	2576	+ success(c) then
	2577	+ if c = '\"'
	2578	+ then implode(reverse(so_far))
	2579	+ else read_attribute_value(where,start+1,end,[c . so_far])
	2580	+ }.
	2581	+
	2582	+define Maybe(String)
	2583	+ find_attribute
	2584	+ (
	2585	+ String name,
	2586	+ ByteArray where,
	2587	+ Int start,
	2588	+ Int end
	2589	+ ) =
	2590	+ with prefix = name+"=\"",
	2591	+ if find(to_byte_array(prefix),where,start) is
	2592	+ {
	2593	+ failure then failure,
	2594	+ success(n) then
	2595	+ if n+length(prefix) >= end
	2596	+ then failure
	2597	+ else success(read_attribute_value(where,n+length(prefix),end,[]))
	2598	+ }.
	2599	+
	2600	+
	2601	+
	2602	+define Maybe((String,Maybe(String)))
	2603	+ find_name_and_filename
	2604	+ (
	2605	+ ByteArray body,
	2606	+ Int start,
	2607	+ Int end
	2608	+ ) =
	2609	+ if find(to_byte_array("Content-Disposition"),body,start) is
	2610	+ {
	2611	+ failure then failure,
	2612	+ success(n) then
	2613	+ if find_attribute("name",body,n+19,end) is
	2614	+ {
	2615	+ failure then failure,
	2616	+ success(name_value) then if find_attribute("filename",body,n+19,end) is
	2617	+ {
	2618	+ failure then success((name_value,failure)),
	2619	+ success(filename_value) then success((name_value,success(filename_value)))
	2620	+ }
	2621	+ }
	2622	+ }.
	2623	+
	2624	+
	2625	+
	2626	+
	2627	+
	2628	+
	2629	+
	2630	+
	2631	+
	2632	+
	2633	+ *** [5.7.3] Creating a temporary filename for an uploaded file.
	2634	+
	2635	+variable Int uploaded_file_count = 0.
	2636	+
	2637	+ This variable is local to the virtual machine. Hence, its value is 0 each time a new
	2638	+ requests arrives. Temporary uploaded files are stored in the directory represented by
	2639	+ 'upload_temporary_directory'. The filenames have the form:
	2640	+
	2641	+ _m_n
	2642	+
	2643	+ where 'm' is the number of the virtual machine, and 'n' a number obtained by
	2644	+ incrementing 'uploaded_file_count'. Notice that the program must do something with this
	2645	+ file (move it to some directory/name), otherwise, it will probably be overwritten the
	2646	+ next time the same machine works.
	2647	+
	2648	+
	2649	+
	2650	+
	2651	+
	2652	+
	2653	+ *** [5.7.4] Saving an uploaded file under a temporary filename.
	2654	+
	2655	+define Maybe(String) // returns the temporary file name
	2656	+ save_uploaded_file
	2657	+ (
	2658	+ Web_Site_Description desc,
	2659	+ ByteArray body,
	2660	+ Int start,
	2661	+ Int end
	2662	+ ) =
	2663	+ uploaded_file_count <- 1 + *uploaded_file_count;
	2664	+ with tfn = "_"+to_decimal(virtual_machine_id)+"_"+to_decimal(*uploaded_file_count),
	2665	+ if (Maybe(RWStream))file(site_directory(desc)+"/upload_temporary/"+tfn, new) is
	2666	+ {
	2667	+ failure then failure,
	2668	+ success(f) then
	2669	+ if reliable_write(file(f),extract(body,start,end)) is
	2670	+ {
	2671	+ failure then failure,
	2672	+ success(nw) then
	2673	+ if nw = end - start
	2674	+ then success(tfn)
	2675	+ else failure
	2676	+ }
	2677	+ }.
	2678	+
	2679	+
	2680	+
	2681	+
	2682	+
	2683	+
	2684	+
	2685	+
	2686	+ *** [5.7.5] Removing the path from a file name.
	2687	+
	2688	+ When a file is uploaded, the browser sends the complete path of the file on the client
	2689	+ machine as the file name. Actually, this is not quite normal. Nevertheless, we need to
	2690	+ remove the path, and keep only the file name. This is achieved by 'remove_path' below.
	2691	+
	2692	+define Int
	2693	+ file_name_begin
	2694	+ (
	2695	+ String full_name,
	2696	+ Int i
	2697	+ ) =
	2698	+ if nth(i,full_name) is
	2699	+ {
	2700	+ failure then 0,
	2701	+ success(c) then
	2702	+ if c = '/' then i+1 else
	2703	+ if c = '\\' then i+1 else
	2704	+ file_name_begin(full_name,i-1)
	2705	+ }.
	2706	+
	2707	+define String
	2708	+ remove_path
	2709	+ (
	2710	+ String full_name
	2711	+ ) =
	2712	+ with l = length(full_name),
	2713	+ b = file_name_begin(full_name,l-1),
	2714	+ substr(full_name,b,l-b).
	2715	+
	2716	+
	2717	+
	2718	+
	2719	+
	2720	+ *** [5.7.6] Reading a multipart entity.
	2721	+
	2722	+define Maybe(Web_arg)
	2723	+ get_multipart_entity
	2724	+ (
	2725	+ Web_Site_Description desc,
	2726	+ ByteArray body,
	2727	+ Int start,
	2728	+ Int end
	2729	+ ) =
	2730	+ if find(to_byte_array(crlf+crlf),body,start) is
	2731	+ {
	2732	+ failure then failure,
	2733	+ success(k) then
	2734	+ if k >= end // must be within this entity, not the next one
	2735	+ then failure
	2736	+ else if find_name_and_filename(body,start,k) is
	2737	+ {
	2738	+ failure then failure,
	2739	+ success(n_mbfn) then if n_mbfn is (name,mbfn) then
	2740	+ if mbfn is
	2741	+ {
	2742	+ failure then
	2743	+ success(web_arg(name,to_string(extract(body,k+4,end-2)))),
	2744	+ // we must substract 2 to end because of crlf just before the boundary
	2745	+
	2746	+ success(fn) then
	2747	+ if save_uploaded_file(desc,body,k+4,end-2) is
	2748	+ {
	2749	+ failure then failure,
	2750	+ success(tfn) then
	2751	+ success(upload(name,remove_path(fn),
	2752	+ site_directory(desc)+"/upload_temporary/"+tfn))
	2753	+
	2754	+ }
	2755	+ }
	2756	+ }
	2757	+ }.
	2758	+
	2759	+
	2760	+
	2761	+define List(Web_arg)
	2762	+ read_multipart_form_data_encoded_web_args
	2763	+ (
	2764	+ Web_Site_Description desc,
	2765	+ ByteArray body,
	2766	+ ByteArray __boundary,
	2767	+ Int i,
	2768	+ ) =
	2769	+ if find(__boundary,body,i) is
	2770	+ {
	2771	+ failure then [ ],
	2772	+ success(n) then
	2773	+ if find(__boundary,body,n+length(__boundary)) is
	2774	+ {
	2775	+ failure then [ ],
	2776	+ success(m) then
	2777	+ if get_multipart_entity(desc,body,n+length(__boundary),m) is
	2778	+ {
	2779	+ failure then [ ],
	2780	+ success(wa) then
	2781	+ [wa . read_multipart_form_data_encoded_web_args(desc,body,__boundary,m)]
	2782	+ }
	2783	+ }
	2784	+ }.
	2785	+
	2786	+
	2787	+
	2788	+define One
	2789	+ multipart_form_data_answer
	2790	+ (
	2791	+ String host_name,
	2792	+ Web_Site_Description desc,
	2793	+ Connection connection,
	2794	+ Word32 ip_addr,
	2795	+ HTTP_RequestLine request_line,
	2796	+ List(HTTP_header) headers,
	2797	+ ByteArray body,
	2798	+ One -> String generate_tt
	2799	+ ) =
	2800	+ if get_boundary(headers) is
	2801	+ {
	2802	+ failure then unique,
	2803	+ success(boundary) then
	2804	+ with all_web_args = query_string(request_line) +
	2805	+ read_multipart_form_data_encoded_web_args(desc,
	2806	+ body,
	2807	+ to_byte_array("--"+boundary),
	2808	+ 0),
	2809	+ uri = uri(request_line),
	2810	+ ext = get_uri_extension(uri),
	2811	+ log_journal_msg(desc,
	2812	+ format_request(desc,connection,request_line,headers,all_web_args));
	2813	+ if is_illegal_uri(uri,0)
	2814	+ then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
	2815	+ else
	2816	+ if (ext = ".awp" \| ext = "") then
	2817	+ (with answer_headers_body = awp_handler(desc)(host_name,
	2818	+ http_info(ip_addr, host_name, uri, headers, is_SSL(connection), generate_tt),
	2819	+ all_web_args,
	2820	+ is_SSL(connection)),
	2821	+ forget(reliable_write(connection, answer_headers_body)))
	2822	+ else unique
	2823	+ }.
	2824	+
	2825	+
	2826	+
	2827	+
	2828	+
	2829	+
	2830	+
	2831	+
	2832	+ *** [5.8] Handling redirections.
	2833	+
	2834	+ 'redirections' (of type 'List(Redirection)') contains redirection directives. Each one
	2835	+ has the form:
	2836	+
	2837	+ redirect(required_uri,required_host,corresponding_uri).
	2838	+
	2839	+ The host required by the client may be found in the 'Host' HTTP header. The URI
	2840	+ required by the client is given below as 'uri'. We just have to find the required host
	2841	+ in the headers, and to find the corresponding redirection directive.
	2842	+
	2843	+
	2844	+ In the next fonction, the required host and URI are known. We just have to search in
	2845	+ the 'redirections' list.
	2846	+
	2847	+define String
	2848	+ handle_redirection
	2849	+ (
	2850	+ String required_uri,
	2851	+ String required_host,
	2852	+ List(Redirection) redirections
	2853	+ ) =
	2854	+ if redirections is
	2855	+ {
	2856	+ [ ] then required_uri,
	2857	+ [h . t] then if h is redirect(uri,host,target) then
	2858	+ if host = required_host
	2859	+ then if uri = required_uri
	2860	+ then target
	2861	+ else handle_redirection(required_uri,required_host,t)
	2862	+ else handle_redirection(required_uri,required_host,t)
	2863	+ }.
	2864	+
	2865	+
	2866	+
	2867	+ The host name may be encumbered by a port number, like
	2868	+
	2869	+ www.our-business.com:1607
	2870	+
	2871	+ We must remove this port number, otherwise the host name may not be recognized.
	2872	+
	2873	+define String
	2874	+ strip_port
	2875	+ (
	2876	+ String name,
	2877	+ Int i
	2878	+ ) =
	2879	+ if nth(i,name) is
	2880	+ {
	2881	+ failure then name,
	2882	+ success(c) then
	2883	+ if c = ':'
	2884	+ then substr(name,0,i)
	2885	+ else strip_port(name,i+1)
	2886	+ }.
	2887	+
	2888	+
	2889	+
	2890	+
	2891	+
	2892	+ Finding the 'Host' header. No redirection is performed if this header is not found.
	2893	+
	2894	+define String
	2895	+ handle_redirection // returns the redirected URI
	2896	+ (
	2897	+ Redirections redirections,
	2898	+ String uri, // original URI
	2899	+ List(HTTP_header) headers
	2900	+ )=
	2901	+ if get_host_header_value(headers) is
	2902	+ {
	2903	+ failure then uri,
	2904	+ success(host) then
	2905	+ if redirections is
	2906	+ {
	2907	+ redirection_list(l) then handle_redirection(uri, host, l)
	2908	+ redirection_fn(f) then f(uri, host)
	2909	+ }
	2910	+ }.
	2911	+
	2912	+
	2913	+
	2914	+
	2915	+
	2916	+
	2917	+ *** [5.9] Answering both sorts of requests.
	2918	+
	2919	+ We must decide if the request is www-url encoded or multipart/form-data encoded. This
	2920	+ is achieved through the header 'Content-Type'.
	2921	+
	2922	+define EncodingType
	2923	+ get_encoding_type
	2924	+ (
	2925	+ List(HTTP_header) headers
	2926	+ ) =
	2927	+ if headers is
	2928	+ {
	2929	+ [ ] then www_url, // this is the default
	2930	+ [h . t] then if h is http_header(name,value) then
	2931	+ if name = "content-type"
	2932	+ then if find("multipart/form-data",value,0) is
	2933	+ {
	2934	+ failure then www_url,
	2935	+ success(_) then multipart_form_data
	2936	+ }
	2937	+ else get_encoding_type(t)
	2938	+ }.
	2939	+
	2940	+
	2941	+
	2942	+define One
	2943	+ send_answer
	2944	+ (
	2945	+ String host_name,
	2946	+ Web_Site_Description desc,
	2947	+ Connection connection,
	2948	+ HTTP_RequestLine rqline,
	2949	+ List(HTTP_header) headers,
	2950	+ ByteArray body,
	2951	+ One -> String generate_tt
	2952	+ ) =
	2953	+ if rqline is request_line(type,uri,qstring) then
	2954	+ with rqline2 = request_line(type,handle_redirection(redirections(desc),uri,headers),qstring),
	2955	+ if remote_IP_address_and_port(connection) is (ip_addr,_) then
	2956	+ if get_encoding_type(headers) is
	2957	+ {
	2958	+ www_url then
	2959	+ www_url_answer(host_name,desc,connection,ip_addr,rqline2,headers,body,generate_tt),
	2960	+ multipart_form_data then
	2961	+ multipart_form_data_answer(host_name,desc,connection,ip_addr,rqline2,headers,body,generate_tt)
	2962	+ }.
	2963	+
	2964	+
	2965	+
	2966	+
	2967	+
	2968	+
	2969	+
	2970	+ *** [6] The HTTP/HTTPS server.
	2971	+
	2972	+ The command 'start_server' (declared in 'predefined.anubis') starts a virtual machine
	2973	+ which opens a server TCP/IP connection, and which continuously listens to this
	2974	+ connection. When a request arrives, this machine delegates the work of deciphering and
	2975	+ answering the request to another virtual machine, and continues to listen. The job of
	2976	+ the delegated machine is defined by the HTTP request handler below.
	2977	+
	2978	+
	2979	+
	2980	+
	2981	+
	2982	+ *** [6.1] Determining the requested host.
	2983	+
	2984	+ When a request arrives to one of our two servers, we must decide which site (host) is
	2985	+ requested.
	2986	+
	2987	+define Maybe(String)
	2988	+ get_host_header_value
	2989	+ (
	2990	+ List(HTTP_header) headers
	2991	+ ) =
	2992	+ if headers is
	2993	+ {
	2994	+ [ ] then failure,
	2995	+ [h . t] then if h is http_header(name,value) then
	2996	+ if name = "host"
	2997	+ then success(strip_port(value,0))
	2998	+ else get_host_header_value(t)
	2999	+ }.
	3000	+
	3001	+define Maybe((String,Web_Site_Description))
	3002	+ get_site
	3003	+ (
	3004	+ String requested_host,
	3005	+ List(Web_Site_Description) sites
	3006	+ ) =
	3007	+ if sites is
	3008	+ {
	3009	+ [ ] then print("Requested host '"+requested_host+"' does not exist.\n"); failure,
	3010	+ [site1 . others] then
	3011	+ if site1 is web_site_description(common_names,_,_,_,_,_,_,_,_,_) then
	3012	+ if member(common_names,requested_host)
	3013	+ then success((requested_host,site1))
	3014	+ else get_site(requested_host,others)
	3015	+ }.
	3016	+
	3017	+
	3018	+define Maybe((String,Web_Site_Description))
	3019	+ get_site
	3020	+ (
	3021	+ List(HTTP_header) headers,
	3022	+ List(Web_Site_Description) sites
	3023	+ ) =
	3024	+ if get_host_header_value(headers) is
	3025	+ {
	3026	+ failure then print("No 'Host' HTTP header.\n"); failure,
	3027	+ success(requested_host) then
	3028	+ //here we treat the case with only one site. hence we accept any host request
	3029	+ //print("*** there is " +length(sites) + " sites \n");
	3030	+ if length(sites) = 1 then
	3031	+ //with site = force_nth(0, sites),
	3032	+ if sites is
	3033	+ {
	3034	+ [] then get_site(requested_host,sites),
	3035	+ [site . t] then success((requested_host, site))
	3036	+ }
	3037	+ else
	3038	+ get_site(requested_host,sites)
	3039	+ }.
	3040	+
	3041	+
	3042	+
	3043	+
	3044	+
	3045	+ *** [6.2] The HTTP request handler.
	3046	+
	3047	+ Here is the HTTP/HTTPS handler. It is called at each new request in a separate virtual
	3048	+ machine. It reads the headers of the HTTP request, determines the host, determines body
	3049	+ size, reads the body of the HTTP request, and answers the request.
	3050	+
	3051	+
	3052	+
	3053	+define One -> String make_generate_trust_ticket(DenialOfService dos).
	3054	+
	3055	+define One
	3056	+ http_https_handler
	3057	+ (
	3058	+ List(Web_Site_Description) sites,
	3059	+ BufferedConnection connection,
	3060	+ Bool is_https,
	3061	+ DenialOfService dos
	3062	+ ) =
	3063	+ //t0 <- (UTime)unow;
	3064	+ with start_time = (Int)now,
	3065	+ sttm <- start_time;
	3066	+ //println("Request time: " + format_http_date(start_time));
	3067	+ if dos is denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
	3068	+ if remote_IP_address_and_port(connection.conn) is (ip_addr,port) then
	3069	+ if read_request_line(connection,start_time+*rld_v,dos) is
	3070	+ {
	3071	+ error(msg) then print(format(msg)),
	3072	+ ok(request_line) then
	3073	+ //print_delta("read_request_line");
	3074	+ if read_http_headers(connection,start_time+*hd_v,dos) is
	3075	+ {
	3076	+ error(msg) then print(format(msg)),
	3077	+ ok(headers) then //print_delta("read_http_headers");
	3078	+ if get_site(headers,sites) is
	3079	+ {
	3080	+ failure then unique,
	3081	+ success(p) then if p is (host_name,desc) then
	3082	+ //print_delta("get_site");
	3083	+ if get_body_size(headers) is
	3084	+ {
	3085	+ error(msg) then log_journal_msg(desc,format(msg)),
	3086	+ ok(body_size) then
	3087	+ //print_delta("get_body_size");
	3088	+ if read_http_body(connection,body_size,constant_byte_array(0,0),1000) is
	3089	+ {
	3090	+ error(msg) then log_journal_msg(desc,format(msg)),
	3091	+ ok(body) then
	3092	+ //print_delta("before send_answer");
	3093	+ send_answer(host_name, desc,connection.conn, request_line, headers, body,
	3094	+ make_generate_trust_ticket(dos))
	3095	+ //with duration = (UTime) unow - *t0,
	3096	+ //println("Request duration: " + __utime_to_string(duration))
	3097	+ //println("BufferRead duration: " + __utime_to_string(*t1));
	3098	+ //println("next_char duration: " + __utime_to_string(*t2))
	3099	+ }
	3100	+ }
	3101	+ }
	3102	+ }
	3103	+ }.
	3104	+
	3105	+
	3106	+ Below are the two tools for constructing the handlers required by 'start_server' and
	3107	+ 'start_ssl_server' (see 'predefined.anubis').
	3108	+
	3109	+define Bool is_dubious_IP(Word32 ip, DenialOfService dos).
	3110	+
	3111	+define Server -> ((RWStream) -> One)
	3112	+ make_http_handler
	3113	+ (
	3114	+ List(Web_Site_Description) sites,
	3115	+ DenialOfService dos
	3116	+ ) =
	3117	+ (Server server) \|-> (RWStream conn) \|->
	3118	+ if remote_IP_address_and_port(conn) is (addr,_) then
	3119	+ if is_dubious_IP(addr,dos)
	3120	+ then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
	3121	+ else
	3122	+ with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),
	3123	+ http_https_handler(sites, connection, false, dos).
	3124	+
	3125	+define Server -> (SSL_Connection -> One)
	3126	+ make_https_handler
	3127	+ (
	3128	+ List(Web_Site_Description) sites,
	3129	+ DenialOfService dos
	3130	+ ) =
	3131	+ (Server server) \|-> (SSL_Connection conn) \|->
	3132	+ with connection = buffered_connection(ssl(conn), var(constant_byte_array(0, 0)), var(0)),
	3133	+ http_https_handler(sites, connection, true, dos).
	3134	+
	3135	+
	3136	+
	3137	+
	3138	+ *** [6.3] Server's tasks.
	3139	+
	3140	+ Some tasks must be executed periodically, for example for cleaning up directories from
	3141	+ short life time files.
	3142	+
	3143	+ The next function removes from the given directory (and recursively from its
	3144	+ subdirectories) all the files which are more than 10 minutes old.
	3145	+
	3146	+define One
	3147	+ cleanup_directory_10mn
	3148	+ (
	3149	+ String dir // path of private download directory (or subdirectory) with trailing slash
	3150	+ ) =
	3151	+ forget(map((FileDescription fd) \|-> if fd is
	3152	+ {
	3153	+ no_info(name) then forget(remove(dir+name)),
	3154	+ file(name,_,_,d) then if to_Int(d)+600 < now then forget(remove(dir+name)) else unique,
	3155	+ link(name,_,_,d) then if to_Int(d)+600 < now then forget(remove(dir+name)) else unique,
	3156	+ directory(name,_,_) then cleanup_directory_10mn(dir+name+"/"),
	3157	+ },
	3158	+ directory_full_list(dir,"","","*"))).
	3159	+
	3160	+
	3161	+define One
	3162	+ http_servers_tasks
	3163	+ (
	3164	+ List(Web_Site_Description) sites,
	3165	+ List(Server) servers,
	3166	+ Int period,
	3167	+ Int next_time,
	3168	+ ) =
	3169	+ if mapand(is_down,servers)
	3170	+ then unique
	3171	+ else if now > next_time
	3172	+ then
	3173	+ (
	3174	+ /*
	3175	+ forget(map((Web_Site_Description wsd) \|->
	3176	+ cleanup_directory_10mn(site_directory(wsd)+"/private_download/"),
	3177	+ sites));
	3178	+ */
	3179	+ http_servers_tasks(sites,servers,period,next_time+period)
	3180	+ )
	3181	+ else
	3182	+ (
	3183	+ sleep(1000);
	3184	+ http_servers_tasks(sites,servers,period,next_time)
	3185	+ ).
	3186	+
	3187	+
	3188	+public define One
	3189	+ start_http_servers_tasks
	3190	+ (
	3191	+ List(Web_Site_Description) sites,
	3192	+ List(Server) servers,
	3193	+ Int period
	3194	+ ) =
	3195	+ delegate http_servers_tasks(sites,servers,period,now),
	3196	+ unique.
	3197	+
	3198	+
	3199	+
	3200	+
	3201	+ *** [6.4] Protection against 'denial of service' attacks.
	3202	+
	3203	+
	3204	+ *** [6.4.1] Counting connections.
	3205	+
	3206	+define Bool // returns false if the counter cannot be incremented (too many connections)
	3207	+ increment_connections_counter
	3208	+ (
	3209	+ Var(Int) counter
	3210	+ ) =
	3211	+ protect with n = *counter,
	3212	+ if n >= 100
	3213	+ then false
	3214	+ else (counter <- (*counter)+1); true.
	3215	+
	3216	+define One
	3217	+ decrement_connections_counter
	3218	+ (
	3219	+ Var(Int) counter
	3220	+ ) =
	3221	+ protect counter <- (*counter)-1.
	3222	+
	3223	+
	3224	+
	3225	+
	3226	+
	3227	+ *** [6.4.2] Recording dubious IP addresses.
	3228	+
	3229	+
	3230	+define List(DubiousIP)
	3231	+ record_dubious_IP
	3232	+ (
	3233	+ Word32 ip,
	3234	+ List(DubiousIP) l
	3235	+ ) =
	3236	+ if l is
	3237	+ {
	3238	+ [ ] then [dubious_ip(ip,now)],
	3239	+ [h . t] then if h is dubious_ip(addr,time) then
	3240	+ if addr = ip
	3241	+ then [dubious_ip(addr,now) . t]
	3242	+ else [h . record_dubious_IP(ip,t)]
	3243	+ }.
	3244	+
	3245	+
	3246	+define One
	3247	+ record_dubious_IP
	3248	+ (
	3249	+ Word32 dubious_IP,
	3250	+ Var(List(DubiousIP)) v
	3251	+ ) =
	3252	+ protect v <- record_dubious_IP(dubious_IP,*v).
	3253	+
	3254	+
	3255	+define One
	3256	+ record_dubious_IP
	3257	+ (
	3258	+ Word32 addr,
	3259	+ DenialOfService dos
	3260	+ ) =
	3261	+ record_dubious_IP(addr,list_of_dubious(dos)).
	3262	+
	3263	+
	3264	+public define DenialOfService
	3265	+ load_denial_of_service_info
	3266	+ =
	3267	+ if (RetrieveResult(DenialOfService))retrieve(my_anubis_directory+"/web_sites/dos_info") is
	3268	+ ok(dos) then dos else denial_of_service(
	3269	+ var(100),
	3270	+ var(1000),
	3271	+ var(1500),
	3272	+ var(2000),
	3273	+ var([]),
	3274	+ var([])).
	3275	+
	3276	+
	3277	+
	3278	+
	3279	+ *** [6.4.3] Testing if an address is dubious.
	3280	+
	3281	+define Bool
	3282	+ is_dubious_IP
	3283	+ (
	3284	+ Word32 ip,
	3285	+ List(DubiousIP) l
	3286	+ ) =
	3287	+ if l is
	3288	+ {
	3289	+ [ ] then false,
	3290	+ [h . t] then if h is dubious_ip(addr,time) then
	3291	+ if ip = addr
	3292	+ then true
	3293	+ else is_dubious_IP(ip,t)
	3294	+ }.
	3295	+
	3296	+
	3297	+define Bool
	3298	+ is_dubious_IP
	3299	+ (
	3300	+ Word32 ip,
	3301	+ DenialOfService dos
	3302	+ ) =
	3303	+ if dos is
	3304	+ {
	3305	+ denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
	3306	+ if member(*ra_v,ip) then false else
	3307	+ is_dubious_IP(ip,*ld_v)
	3308	+ }.
	3309	+
	3310	+
	3311	+
	3312	+
	3313	+ *** [6.4.4] Removing inactive dubious IP addresses.
	3314	+
	3315	+define List(DubiousIP)
	3316	+ remove_inactive_dubious_IP
	3317	+ (
	3318	+ List(DubiousIP) l,
	3319	+ Int ref_time,
	3320	+ ) =
	3321	+ if l is
	3322	+ {
	3323	+ [ ] then [ ],
	3324	+ [h . t] then if h is dubious_ip(addr,time) then
	3325	+ if time < ref_time
	3326	+ then (print(ip_addr_to_string(addr)+" removed from dubious addresses list.\n");
	3327	+ remove_inactive_dubious_IP(t,ref_time))
	3328	+ else [h . remove_inactive_dubious_IP(t,ref_time)]
	3329	+ }.
	3330	+
	3331	+define One
	3332	+ remove_inactive_dubious_IP
	3333	+ (
	3334	+ Var(List(DubiousIP)) v
	3335	+ ) =
	3336	+ protect
	3337	+ with ref_time = (Int)now - 600, // 10 minutes
	3338	+ v <- remove_inactive_dubious_IP(*v,ref_time).
	3339	+
	3340	+
	3341	+ The above function will be executed periodically by the servers's tasks machine.
	3342	+
	3343	+
	3344	+
	3345	+ *** [6.4.5] Making the function for generating trust tickets.
	3346	+
	3347	+define One -> String
	3348	+ make_generate_trust_ticket
	3349	+ (
	3350	+ DenialOfService dos
	3351	+ ) =
	3352	+ (One _) \|-> "".
	3353	+
	3354	+
	3355	+
	3356	+
	3357	+
	3358	+
	3359	+
	3360	+ *** [6.5] Starting the HTTP/HTTPS server.
	3361	+
	3362	+
	3363	+ The next function creates the directories for all sites (if they don't already exist).
	3364	+
	3365	+define One
	3366	+ create_directories
	3367	+ (
	3368	+ List(Web_Site_Description) sites
	3369	+ ) =
	3370	+ if sites is
	3371	+ {
	3372	+ [ ] then unique,
	3373	+ [s1 . others] then
	3374	+ with site_dir = site_directory(s1),
	3375	+ forget(make_directory(site_dir+"/public",default_directory_mode));
	3376	+ forget(make_directory(site_dir+"/upload_temporary",default_directory_mode));
	3377	+ forget(make_directory(site_dir+"/private_download",default_directory_mode));
	3378	+ forget(make_directory(site_dir+"/journal",default_directory_mode));
	3379	+ create_directories(others)
	3380	+ }.
	3381	+
	3382	+
	3383	+
	3384	+
	3385	+
	3386	+ Below are the commands for starting an HTTP server and an HTTPS server.
	3387	+
	3388	+
	3389	+define StartServerResult
	3390	+ start_http_server
	3391	+ (
	3392	+ Word32 ip_address,
	3393	+ Word32 port,
	3394	+ Server -> ((RWStream) -> One) handler,
	3395	+ Int retries,
	3396	+ DenialOfService dos
	3397	+ ) =
	3398	+ if start_server(ip_address,
	3399	+ port,
	3400	+ handler,
	3401	+ identity) is ok(server)
	3402	+ then print(" \r");
	3403	+ ok(server)
	3404	+ else print("Port "+port+": retry number "+retries+"\r");
	3405	+ sleep(1000);
	3406	+ start_http_server(ip_address,port,handler,retries+1,dos).
	3407	+
	3408	+public define StartServerResult
	3409	+ start_http_server
	3410	+ (
	3411	+ Word32 ip_address,
	3412	+ Word32 port,
	3413	+ List(Web_Site_Description) sites,
	3414	+ DenialOfService dos
	3415	+ ) =
	3416	+ create_directories(sites);
	3417	+ start_http_server(ip_address,port,
	3418	+ make_http_handler(sites,dos),
	3419	+ 0,
	3420	+ dos).
	3421	+
	3422	+
	3423	+ For the HTTPS server, we have a problem which is due to the fact that 'anbexec' is not
	3424	+ yet able to manipulate several SSL server certificates. 'anbexec' and
	3425	+ 'predefined.anubis' must be changed. Sorry ! This will be done as soon as possible. The
	3426	+ 'solution' for the time being is to provide the common name of the unique SSL server
	3427	+ certificate.
	3428	+
	3429	+
	3430	+define StartServerResult
	3431	+ start_https_server
	3432	+ (
	3433	+ Word32 ip_address,
	3434	+ Word32 port,
	3435	+ String certificate_common_name,
	3436	+ Server -> (SSL_Connection -> One) handler,
	3437	+ Int retries,
	3438	+ DenialOfService dos
	3439	+ ) =
	3440	+ if start_ssl_server(ip_address,
	3441	+ port,
	3442	+ certificate_common_name,
	3443	+ handler,
	3444	+ identity) is ok(server)
	3445	+ then print(" \r");
	3446	+ ok(server)
	3447	+ else print("Port "+port+": retry number "+retries+"\r");
	3448	+ sleep(1000);
	3449	+ start_https_server(ip_address,port,
	3450	+ certificate_common_name,
	3451	+ handler,retries+1,
	3452	+ dos).
	3453	+
	3454	+
	3455	+public define StartServerResult
	3456	+ start_https_server
	3457	+ (
	3458	+ Word32 ip_address,
	3459	+ Word32 port,
	3460	+ String certificate_common_name, // of SSL server certificate
	3461	+ List(Web_Site_Description) sites,
	3462	+ DenialOfService dos
	3463	+ ) =
	3464	+ create_directories(sites);
	3465	+ start_https_server(ip_address,port,certificate_common_name,
	3466	+ make_https_handler(sites,dos),
	3467	+ 0,dos).
	3468	+
	3469	+
	3470	+
	3471	+
	3472	+
	3473	+
	3474	+
	3475	+
	3476	+
	3477	+ *** [7] The web dispatcher.
	3478	+
	3479	+
	3480	+ *** [7.1] The dispatcher server.
	3481	+
	3482	+define One
	3483	+ send_dispatching_page
	3484	+ (
	3485	+ RWStream conn,
	3486	+ String common_name,
	3487	+ Word32 port
	3488	+ ) =
	3489	+ print("Dispatching '"+common_name+"' to port "+port+"\n");
	3490	+ forget(reliable_write(conn,to_byte_array(
	3491	+ "<html><head><meta http-equiv=\"Refresh\" content=\"0;URL="+
	3492	+ "http://"+common_name+":"+port+"/"+
	3493	+ "\"></head><body></body></html>"
	3494	+ ))).
	3495	+
	3496	+
	3497	+
	3498	+define Maybe(DispatcherInfo)
	3499	+ find_host
	3500	+ (
	3501	+ List(DispatcherInfo) l,
	3502	+ String host
	3503	+ ) =
	3504	+ if l is
	3505	+ {
	3506	+ [ ] then failure,
	3507	+ [h . t] then if h is site(name,port) then
	3508	+ if name = host
	3509	+ then success(h)
	3510	+ else find_host(t,host)
	3511	+ }.
	3512	+
	3513	+
	3514	+
	3515	+define Server -> ((RWStream) -> One)
	3516	+ make_dispatcher_handler
	3517	+ (
	3518	+ Var(List(DispatcherInfo)) info_v,
	3519	+ DenialOfService dos
	3520	+ ) =
	3521	+ (Server server) \|-> (RWStream conn) \|->
	3522	+ with start_time = (Int)now,
	3523	+ connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),
	3524	+ if read_request_line(connection, start_time+*request_line_delay(dos), dos) is
	3525	+ {
	3526	+ error(msg) then print(format(msg)),
	3527	+ ok(request_line) then
	3528	+ if read_http_headers(connection, start_time+*headers_delay(dos), dos) is
	3529	+ {
	3530	+ error(msg) then print(format(msg)),
	3531	+ ok(headers) then if get_host_header_value(headers) is
	3532	+ {
	3533	+ failure then print("No 'HOST' HTTP header.\n"),
	3534	+ success(host) then
	3535	+ if find_host(*info_v,host) is
	3536	+ {
	3537	+ failure then print("Host: '"+host+"' not registered.\n"),
	3538	+ success(s) then if s is site(common_name,ip_port) then
	3539	+ send_dispatching_page(conn,common_name,ip_port)
	3540	+ }
	3541	+ }
	3542	+ }
	3543	+ }.
	3544	+
	3545	+
	3546	+define One
	3547	+ dispatcher_update_error
	3548	+ (
	3549	+ String file_path
	3550	+ ) =
	3551	+ print("web_dispatcher: unable to reread file: '"+file_path+"'.\n").
	3552	+
	3553	+
	3554	+define Bool
	3555	+ dispatcher_update_data
	3556	+ (
	3557	+ String info_file_path,
	3558	+ Var(List(DispatcherInfo)) info_v,
	3559	+ Var(Int) info_date_v
	3560	+ ) =
	3561	+ if directory_full_list(my_anubis_directory+"/web_sites","dispatcher.info","","") is
	3562	+ {
	3563	+ [ ] then false,
	3564	+ [h . t] then if h is
	3565	+ {
	3566	+ no_info(n) then false,
	3567	+ file(n,_,_,d) then if n = "dispatcher.info"
	3568	+ then (info_date_v <- to_Int(d);
	3569	+ if (RetrieveResult(List(DispatcherInfo)))retrieve(info_file_path) is
	3570	+ {
	3571	+ cannot_find_file then false,
	3572	+ read_error then false,
	3573	+ type_error then false,
	3574	+ ok(info) then info_v <- info; true
	3575	+ })
	3576	+ else false,
	3577	+ link(_,_,_,_) then false,
	3578	+ directory(_,_,_) then false
	3579	+ }
	3580	+ }.
	3581	+
	3582	+
	3583	+
	3584	+ The loop within which the dispatcher updates its data every 3 seconds:
	3585	+
	3586	+define One
	3587	+ dispatcher_update_task
	3588	+ (
	3589	+ String info_file_path,
	3590	+ Var(List(DispatcherInfo)) info_v,
	3591	+ Var(Int) info_date_v
	3592	+ ) =
	3593	+ sleep(3000);
	3594	+ (if dispatcher_update_data(info_file_path,info_v,info_date_v)
	3595	+ then unique
	3596	+ else dispatcher_update_error(info_file_path));
	3597	+ dispatcher_update_task(info_file_path,info_v,info_date_v).
	3598	+
	3599	+
	3600	+public define One
	3601	+ start_web_dispatcher
	3602	+ (
	3603	+ Word32 ip_address, // address for listening (typically 0: listen on all interfaces)
	3604	+ Word32 http_port, // typically 80
	3605	+ DenialOfService dos
	3606	+ ) =
	3607	+ with info_file_path = my_anubis_directory+"/web_sites/dispatcher.info",
	3608	+ info_v = var((List(DispatcherInfo))[]),
	3609	+ info_date_v = var((Int)0),
	3610	+ if dispatcher_update_data(info_file_path,info_v,info_date_v)
	3611	+ then if start_server(ip_address,
	3612	+ http_port,
	3613	+ make_dispatcher_handler(info_v,dos),
	3614	+ (One u)\|->u) is
	3615	+ {
	3616	+ cannot_create_the_socket then
	3617	+ print("Cannot create the socket for HTTP server.\n"),
	3618	+ cannot_bind_to_port then
	3619	+ print("Cannot bind HTTP server to port "+http_port+".\n"),
	3620	+ cannot_listen_on_port then
	3621	+ print("HTTP server cannot listen on port "+http_port+".\n"),
	3622	+ ok(http_server) then
	3623	+ dispatcher_update_task(info_file_path,info_v,info_date_v)
	3624	+ }
	3625	+ else dispatcher_update_error(info_file_path).
	3626	+
	3627	+
	3628	+
	3629	+ *** [7.2] The dispatcher web site.
	3630	+
	3631	+ global define One
	3632	+ web_dispatcher
	3633	+ (
	3634	+ List(String) args
	3635	+ ) =
	3636	+ start_web_dispatcher(0,80,load_denial_of_service_info).
	3637	+
	3638	+
	3639	+
	3640	+
	3641	+
	3642	+
	3643	+ *** [7.3] Managing the info file.
	3644	+
	3645	+define Word32
	3646	+ register_ip_address
	3647	+ =
	3648	+ if ip_address(prompt(" numerical IP address (for HTTP): ")) is
	3649	+ {
	3650	+ failure then print(" *** Error: incorrect IP address.\n");
	3651	+ register_ip_address,
	3652	+ success(n) then n
	3653	+ }.
	3654	+
	3655	+
	3656	+define Word32
	3657	+ register_ip_port
	3658	+ =
	3659	+ if decimal_scan(prompt(" IP port (for HTTP): ")) is
	3660	+ {
	3661	+ failure then print(" *** Error: incorrect IP port.\n");
	3662	+ register_ip_port,
	3663	+ success(p) then if (0 =< p & p =< 65535)
	3664	+ then truncate_to_Word32(p)
	3665	+ else print(" *** Error: IP port out of bounds.\n");
	3666	+ register_ip_port
	3667	+ }.
	3668	+
	3669	+
	3670	+define One
	3671	+ register_new_site
	3672	+ (
	3673	+ Var(List(DispatcherInfo)) info_v
	3674	+ ) =
	3675	+ print("\n");
	3676	+ print(" Registering a new site:\n");
	3677	+ with name = prompt(" Site name: "),
	3678	+ with addr = register_ip_address,
	3679	+ with port = register_ip_port,
	3680	+ (protect info_v <- [site(name,port) . *info_v]);
	3681	+ print(" Site "+name+" at "+ip_addr_to_string(addr)+":"+port+" added\n (but not saved to disk).\n").
	3682	+
	3683	+
	3684	+define List(DispatcherInfo)
	3685	+ find_sites
	3686	+ (
	3687	+ List(DispatcherInfo) l,
	3688	+ String name
	3689	+ ) =
	3690	+ if l is
	3691	+ {
	3692	+ [ ] then [ ],
	3693	+ [h . t] then if h is site(n,_) then
	3694	+ if find(name,n,0) is
	3695	+ {
	3696	+ failure then find_sites(t,name),
	3697	+ success(_) then [h . find_sites(t,name)]
	3698	+ }
	3699	+ }.
	3700	+
	3701	+
	3702	+define String
	3703	+ pad
	3704	+ (
	3705	+ String s,
	3706	+ Int l
	3707	+ ) =
	3708	+ if length(s) >= l
	3709	+ then s
	3710	+ else s+constant_string(l-length(s),' ').
	3711	+
	3712	+
	3713	+
	3714	+define One
	3715	+ show_sites_1
	3716	+ (
	3717	+ List(DispatcherInfo) l,
	3718	+ Int i
	3719	+ ) =
	3720	+ if l is
	3721	+ {
	3722	+ [ ] then unique,
	3723	+ [h . t] then if h is site(name,port) then
	3724	+ print(" ["+i+"] "+pad(name,40)+" "+" "+port+"\n");
	3725	+ show_sites_1(t,i+1)
	3726	+ }.
	3727	+
	3728	+
	3729	+define One
	3730	+ show_sites
	3731	+ (
	3732	+ List(DispatcherInfo) l,
	3733	+ Int i
	3734	+ ) =
	3735	+ print(" Name Port\n");
	3736	+ print(" --------------------------------------------------------\n");
	3737	+ show_sites_1(l,i).
	3738	+
	3739	+define List(DispatcherInfo)
	3740	+ replace_info
	3741	+ (
	3742	+ List(DispatcherInfo) l,
	3743	+ String site_name,
	3744	+ Word32 new_port
	3745	+ ) =
	3746	+ if l is
	3747	+ {
	3748	+ [ ] then print("ALERT: Empty list into replace_info() [" + __FILE__ + "]\n"); [],
	3749	+ [h . t] then if h is site(n,_) then
	3750	+ if n = site_name
	3751	+ then [site(n,new_port) . t]
	3752	+ else [h . replace_info(t,site_name,new_port)]
	3753	+ }.
	3754	+
	3755	+define List(DispatcherInfo)
	3756	+ delete_info
	3757	+ (
	3758	+ List(DispatcherInfo) l,
	3759	+ String site_name,
	3760	+ ) =
	3761	+ if l is
	3762	+ {
	3763	+ [ ] then print("ALERT: Empty list into delete_info() [" + __FILE__ + "]\n"); [],
	3764	+ [h . t] then if h is site(n,_) then
	3765	+ if n = site_name
	3766	+ then t
	3767	+ else [h . delete_info(t,site_name)]
	3768	+ }.
	3769	+
	3770	+
	3771	+define One
	3772	+ update_site
	3773	+ (
	3774	+ Var(List(DispatcherInfo)) info_v,
	3775	+ String site_name,
	3776	+ Word32 old_port
	3777	+ ) =
	3778	+ print("\n");
	3779	+ print(" Updating site '"+site_name+"': (currently: "+old_port+")\n");
	3780	+ with new_port = register_ip_port,
	3781	+ answer = prompt(" Update '"+site_name+"' as: "+new_port+" [Y/N] ? "),
	3782	+ if (answer = "Y" \| answer = "y")
	3783	+ then info_v <- replace_info(*info_v,site_name,new_port)
	3784	+ else unique.
	3785	+
	3786	+
	3787	+
	3788	+define Bool
	3789	+ compare
	3790	+ (
	3791	+ DispatcherInfo d1,
	3792	+ DispatcherInfo d2
	3793	+ ) =
	3794	+ if d1 is site(n1,_) then
	3795	+ if d2 is site(n2,_) then
	3796	+ string_less(n1,n2).
	3797	+
	3798	+
	3799	+
	3800	+define One
	3801	+ update_site
	3802	+ (
	3803	+ Var(List(DispatcherInfo)) info_v
	3804	+ ) =
	3805	+ print("\n");
	3806	+ with prefix = prompt(" Search for site to update: "),
	3807	+ if find_sites(*info_v,prefix) is
	3808	+ {
	3809	+ [ ] then print(" No site found.\n");
	3810	+ update_site(info_v),
	3811	+ [h . t] then
	3812	+ show_sites(qsort([h . t],compare),1);
	3813	+ with i1 = prompt(" Choose a site to update [1/.../"+(length(t)+1)+"]: "),
	3814	+ if decimal_scan(i1) is
	3815	+ {
	3816	+ failure then print(" *** Error: site number not recognized.\n");
	3817	+ update_site(info_v),
	3818	+ success(ii1) then if nth(ii1-1,*info_v) is
	3819	+ {
	3820	+ failure then print(" *** Error: site number "+i1+" does not exist.\n");
	3821	+ update_site(info_v),
	3822	+ success(site_info) then if site_info is site(name,old_port) then
	3823	+ update_site(info_v,name,old_port)
	3824	+ }
	3825	+ }
	3826	+ }.
	3827	+
	3828	+
	3829	+define One
	3830	+ delete_site
	3831	+ (
	3832	+ Var(List(DispatcherInfo)) info_v,
	3833	+ String site_name,
	3834	+ Word32 old_port
	3835	+ ) =
	3836	+ print("\n");
	3837	+ print(" Deleting site '"+site_name+"': (currently: "+old_port+")\n");
	3838	+ with answer = prompt(" Are you sure you want to delete site: '"+site_name+"' [Y/N] ? "),
	3839	+ if (answer = "Y" \| answer = "y")
	3840	+ then info_v <- delete_info(*info_v,site_name)
	3841	+ else print(" Site '"+site_name+"' not deleted.\n").
	3842	+
	3843	+
	3844	+define One
	3845	+ delete_site
	3846	+ (
	3847	+ Var(List(DispatcherInfo)) info_v
	3848	+ ) =
	3849	+ print("\n");
	3850	+ with prefix = prompt(" Search for site to delete: "),
	3851	+ if find_sites(*info_v,prefix) is
	3852	+ {
	3853	+ [ ] then print(" No site found.\n");
	3854	+ delete_site(info_v),
	3855	+ [h . t] then
	3856	+ show_sites(qsort([h . t],compare),1);
	3857	+ with i1 = prompt(" Choose a site to delete [1/.../"+(length(t)+1)+"]: "),
	3858	+ if decimal_scan(i1) is
	3859	+ {
	3860	+ failure then print(" *** Error: site number not recognized.\n");
	3861	+ delete_site(info_v),
	3862	+ success(ii1) then if nth(ii1-1,*info_v) is
	3863	+ {
	3864	+ failure then print(" *** Error: site number "+i1+" does not exist.\n");
	3865	+ delete_site(info_v),
	3866	+ success(site_info) then if site_info is site(name,old_port) then
	3867	+ delete_site(info_v,name,old_port)
	3868	+ }
	3869	+ }
	3870	+ }.
	3871	+
	3872	+
	3873	+define One
	3874	+ manager
	3875	+ (
	3876	+ Var(List(DispatcherInfo)) info_v,
	3877	+ String file_path
	3878	+ ) =
	3879	+ print("\n");
	3880	+ print(" --- Welcome to the Web Dispatcher Manager ---\n");
	3881	+ with l = length(*info_v),
	3882	+ print(" "+l+" site"+(if l>1 then "s" else "")+" currently registred.\n");
	3883	+ print(" [L] List registered sites.\n");
	3884	+ print(" [R] Register a new site.\n");
	3885	+ print(" [U] Update a registred site.\n");
	3886	+ print(" [D] Delete a registred site.\n");
	3887	+ with propose_write_v = var((Bool)true),
	3888	+ action = prompt(" Choose an action [L/R/U/D]: "),
	3889	+ (if (action = "L" \| action = "l") then (show_sites(*info_v,1); propose_write_v <- false) else
	3890	+ if (action = "R" \| action = "r") then register_new_site(info_v) else
	3891	+ if (action = "U" \| action = "u") then update_site(info_v) else
	3892	+ if (action = "D" \| action = "d") then delete_site(info_v) else
	3893	+ print("Action not recognized.\n"));
	3894	+ print("\n");
	3895	+ if *propose_write_v then
	3896	+ with result = prompt(" Write modifications to data base [Y/N] ?"),
	3897	+ if (result = "Y" \| result = "y")
	3898	+ then if save(*info_v,file_path) is
	3899	+ {
	3900	+ cannot_open_file then print(" File '"+file_path+"' not found.\n"),
	3901	+ write_error then print(" Error while writing file '"+file_path+"'.\n"),
	3902	+ ok then print(" Data base has been modified.\n")
	3903	+ }
	3904	+ else print(" Data base not modified.\n")
	3905	+ else unique.
	3906	+
	3907	+
	3908	+
	3909	+global define One
	3910	+ manage_web_dispatcher
	3911	+ (
	3912	+ List(String) args
	3913	+ ) =
	3914	+ with info_v = var((List(DispatcherInfo))[]),
	3915	+ with file_path = my_anubis_directory+"/web_sites/dispatcher.info",
	3916	+ if (RetrieveResult(List(DispatcherInfo)))retrieve(file_path) is
	3917	+ {
	3918	+ cannot_find_file then print("File '"+file_path+"' does not exist.\n");
	3919	+ with answer = prompt("Create it [Y/N] ? "),
	3920	+ if (answer = "Y" \| answer = "y")
	3921	+ then if save((List(DispatcherInfo))[],file_path) is
	3922	+ {
	3923	+ cannot_open_file then
	3924	+ print("Cannot create file '"+file_path+"'.\n"),
	3925	+ write_error then
	3926	+ print("Error while creating file '"+file_path+"'.\n"),
	3927	+ ok then manager(info_v,file_path)
	3928	+ }
	3929	+ else unique,
	3930	+ read_error then print("Error while reading file '"+file_path+"'.\n"),
	3931	+ type_error then print("File '"+file_path+"' is corrupted.\n"),
	3932	+ ok(info) then info_v <- info;
	3933	+ manager(info_v,file_path)
	3934	+ }.
	3935	+
	3936	+
	3937	+
	3938	+
	3939	+
	3940	+public define (String, List(HTTP_header))
	3941	+ format
	3942	+ (
	3943	+ HTTP_Status status
	3944	+ ) =
	3945	+ if status is
	3946	+ {
	3947	+ http_continue then ("100 Continue", []),
	3948	+ http_switching_protocol then ("101 Switching Protocols", []),
	3949	+
	3950	+ http_ok then ("200 OK", []),
	3951	+ http_created then ("201 Created", []),
	3952	+ http_accepted then ("202 Accepted", []),
	3953	+ http_non_authoritative_info then ("203 Non-Authoritative Information", []),
	3954	+ http_no_content then ("204 No Content", []),
	3955	+ http_reset_content then ("205 Reset Content", []),
	3956	+ http_partial_content then ("206 Partial Content", []),
	3957	+
	3958	+ http_multiple_choices then ("300 Multiple Choices", []),
	3959	+ http_moved_permanently(loc) then ("301 Moved Permanently", [http_header("Location", loc)]),
	3960	+ http_moved_temporarily(loc) then ("302 Moved Temporarily", [http_header("Location", loc)]),
	3961	+ http_see_other(loc) then ("303 See Other", [http_header("Location", loc)]),
	3962	+ http_not_modified then ("304 Not Modified", []),
	3963	+ http_use_proxy(loc) then ("305 Use Proxy", [http_header("Location", loc)]),
	3964	+ http_temporary_redirect(loc) then ("307 Temporary Redirect", [http_header("Location", loc)]),
	3965	+
	3966	+ http_bad_request then ("400 Bad Request", []),
	3967	+ http_unauthorized then ("401 Unauthorized", []),
	3968	+ http_payment_required then ("402 Payment Required", []),
	3969	+ http_forbidden then ("403 Forbidden", []),
	3970	+ http_not_found then ("404 Not Found", []),
	3971	+ http_method_not_allowed then ("405 Method Not Allowed", []),
	3972	+ http_not_acceptable then ("406 Not Acceptable", []),
	3973	+ http_proxy_authentification_required then ("407 Proxy Authentication Required", []),
	3974	+ http_request_timeout then ("408 Request Time-out", []),
	3975	+ http_conflict then ("409 Conflict", []),
	3976	+ http_gone then ("410 Gone", []),
	3977	+ http_length_required then ("411 Length Required", []),
	3978	+ http_precondition_failed then ("412 Precondition Failed", []),
	3979	+ http_request_entity_too_large then ("413 Request Entity Too Large", []),
	3980	+ http_request_uri_too_long then ("414 Request-URI Too Long", []),
	3981	+ http_unsupported_media_type then ("415 Unsupported Media Type", []),
	3982	+ http_request_range_unsatisfiable then ("416 Requested range unsatisfiable", []),
	3983	+ http_expectation_failed then ("417 Expectation failed", []),
	3984	+
	3985	+ http_internal_server_error then ("500 Internal Server Error", []),
	3986	+ http_not_implemented then ("501 Not Implemented", []),
	3987	+ http_bad_gateway then ("502 Bad Gateway", []),
	3988	+ http_service_unavailable then ("503 Service Unavailable", []),
	3989	+ http_gateway_timeout then ("504 Gateway Time-out", []),
	3990	+ http_version_not_supported then ("505 HTTP Version not supported", []),
	3991	+
	3992	+ http_error(code, message) then (abs_to_decimal(code) + " " + message, [])
	3993	+ }.
	3994	+
	3995	+
...	...