Commit 027a26df369f5178fc8bfa94a110b241db60614f

Authored by David RENE
1 parent f45ea158

add read system/string.anubis for to_upper and to_lower functions

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