Commit 5925c1088535c46601077c699d19769c1229c706

Authored by Cédric RICARD
1 parent 2f50a0df

Browsing optimization using browser cache (with the use of header 'Etag')

calexium_lib/web/CXM_generic_login.anubis
1   -
2   -
3   -
4   -
5   - Rationalisation de la gestion des logins et des mots de passe
6   -
7   -read CXM_common.anubis
8   -read CXM_making_a_web_site.anubis
9   -read CXM_generic_form.anubis
10   -
11   -
12   -
13   -
14   - *** (1) Connection sur site sécurisée
15   -
16   - ou formulaire de saisie du login et du mot de passe
17   -
18   -
19   - Le formulaire de saisie du login et du mot de passe pour se connecter à un site https
20   - se compose :
21   - .1. d'un éventuel message pour alerter que la paire (login,passwd) est erronée,
22   - .2. du formulaire proprement dit pour lequel il faut donner :
23   - - le titre du formulaire
24   - - les textes figurant devant les 2 texts input
25   - - le text du bouton submit
26   - - le nom de l'action,
27   - - la couleur de fond
28   -
29   -
30   -
31   -public define HTML_Off_Form
32   - login_form
33   - (
34   - String wrong_message,
35   - RGB background_color,
36   - String title_text,
37   - String pseudo_text,
38   - String passwd_text,
39   - String submit_text,
40   - String login_action
41   - ).
42   -
43   -
44   -
45   -
46   - *** (2) Vérification de la saisie
47   -
48   -
49   -public define Maybe($User)
50   - check_login_passwd
51   - (
52   - String -> Maybe($User) check_pseudo,
53   - $User -> ByteArray get_passwd,
54   - List(Web_arg) lwa
55   - ).
56   -
57   -
58   -
59   - --- That's all for the public part ! --------------------------------------------------
60   -
61   -
62   -
63   - *** [1] Connection sur site sécurisée
64   -
65   -public define HTML_Off_Form
66   - login_form
67   - (
68   - String wrong_message,
69   - RGB background_color,
70   - String title_text,
71   - String pseudo_text,
72   - String passwd_text,
73   - String submit_text,
74   - String login_action
75   - ) =
76   - generic_form
77   - ("login_form",background_color,700,
78   - [
79   - title (title_text),
80   - explain (wrong_message),
81   - input ("pseudo",pseudo_text,narrow,"",mandatory),
82   - password_input ("passwd",passwd_text,mandatory),
83   - submit (login_action,failure,submit_text,[])
84   - ]).
85   -
86   -
87   -
88   - *** [2] Vérification de la saisie
89   -
90   -public define Maybe($User)
91   - check_login_passwd
92   - (
93   - String -> Maybe($User) check_pseudo,
94   - $User -> ByteArray get_passwd,
95   - List(Web_arg) lwa
96   - ) =
97   - if web_arg_value(lwa,"pseudo") is
98   - {
99   - not_found then failure,
100   - found(ps) then
101   - if web_arg_value(lwa,"passwd") is
102   - {
103   - not_found then failure,
104   - found(pwd) then
105   - if check_pseudo(ps) is
106   - {
107   - failure then failure,
108   - success(user) then
109   - if sha1(pwd)=get_passwd(user)
110   - then success(user)
111   - else failure
112   - }
113   - }}.
114   -
115   -
116   -
  1 +
  2 +
  3 +
  4 +
  5 + Rationalisation de la gestion des logins et des mots de passe
  6 +
  7 +read CXM_common.anubis
  8 +read CXM_making_a_web_site.anubis
  9 +read CXM_generic_form.anubis
  10 +
  11 +
  12 +
  13 +
  14 + *** (1) Connection sur site sécurisée
  15 +
  16 + ou formulaire de saisie du login et du mot de passe
  17 +
  18 +
  19 + Le formulaire de saisie du login et du mot de passe pour se connecter à un site https
  20 + se compose :
  21 + .1. d'un éventuel message pour alerter que la paire (login,passwd) est erronée,
  22 + .2. du formulaire proprement dit pour lequel il faut donner :
  23 + - le titre du formulaire
  24 + - les textes figurant devant les 2 texts input
  25 + - le text du bouton submit
  26 + - le nom de l'action,
  27 + - la couleur de fond
  28 +
  29 +
  30 +
  31 +public define HTML_Off_Form
  32 + login_form
  33 + (
  34 + String wrong_message,
  35 + RGB background_color,
  36 + String title_text,
  37 + String pseudo_text,
  38 + String passwd_text,
  39 + String submit_text,
  40 + String login_action
  41 + ).
  42 +
  43 +
  44 +
  45 +
  46 + *** (2) Vérification de la saisie
  47 +
  48 +
  49 +public define Maybe($User)
  50 + check_login_passwd
  51 + (
  52 + String -> Maybe($User) check_pseudo,
  53 + $User -> ByteArray get_passwd,
  54 + List(Web_arg) lwa
  55 + ).
  56 +
  57 +
  58 +
  59 + --- That's all for the public part ! --------------------------------------------------
  60 +
  61 +
  62 +
  63 + *** [1] Connection sur site sécurisée
  64 +
  65 +public define HTML_Off_Form
  66 + login_form
  67 + (
  68 + String wrong_message,
  69 + RGB background_color,
  70 + String title_text,
  71 + String pseudo_text,
  72 + String passwd_text,
  73 + String submit_text,
  74 + String login_action
  75 + ) =
  76 + generic_form
  77 + ("login_form",background_color,700,
  78 + [
  79 + title (title_text),
  80 + explain (wrong_message),
  81 + input ("pseudo",pseudo_text,narrow,"",mandatory),
  82 + password_input ("passwd",passwd_text,mandatory),
  83 + submit (login_action,failure,submit_text,[])
  84 + ]).
  85 +
  86 +
  87 +
  88 + *** [2] Vérification de la saisie
  89 +
  90 +public define Maybe($User)
  91 + check_login_passwd
  92 + (
  93 + String -> Maybe($User) check_pseudo,
  94 + $User -> ByteArray get_passwd,
  95 + List(Web_arg) lwa
  96 + ) =
  97 + if web_arg_value(lwa,"pseudo") is
  98 + {
  99 + not_found then failure,
  100 + found(ps) then
  101 + if web_arg_value(lwa,"passwd") is
  102 + {
  103 + not_found then failure,
  104 + found(pwd) then
  105 + if check_pseudo(ps) is
  106 + {
  107 + failure then failure,
  108 + success(user) then
  109 + if sha1(to_byte_array(pwd))=get_passwd(user)
  110 + then success(user)
  111 + else failure
  112 + }
  113 + }}.
  114 +
  115 +
  116 +
... ...
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) 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   -
  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 + String etag,
  1867 + ) =
  1868 + [
  1869 + http_header("Content-Type",mime_type),
  1870 + http_header("Etag", etag),
  1871 + http_header("Content-Length",integer_to_string(size)),
  1872 + ].
  1873 +
  1874 +
  1875 +
  1876 + Sending the body of the answer (i.e. the file itself).
  1877 +
  1878 +define One
  1879 + send_file_body
  1880 + (
  1881 + Web_Site_Description desc,
  1882 + Connection connection, // connection with the client
  1883 + Connection file, // file to be sent already opened
  1884 + Int32 size, // size of file
  1885 + Int32 sent, // bytes already sent
  1886 + String filename // name of file
  1887 + ) =
  1888 + if sent >= size then unique else
  1889 + if read(file,min(10000,size-sent),60) is
  1890 + {
  1891 + error then log_journal_msg(desc,"Cannot read from file '"+filename+"'.\n"),
  1892 + timeout then log_journal_msg(desc,"Cannot read from file timeoput'"+filename+"'.\n"),
  1893 + ok(ba) then
  1894 + with nr = length(ba), // get the number of bytes read
  1895 + if reliable_write(connection,ba) is
  1896 + {
  1897 + failure then log_journal_msg(desc,"Cannot write into connection.\n"),
  1898 + success(nw) then
  1899 + send_file_body(desc,connection,file,size,sent+nw,filename)
  1900 + }
  1901 + }.
  1902 +
  1903 +
  1904 +define String
  1905 + compute_etag
  1906 + (
  1907 + String filename,
  1908 + Int32 size,
  1909 + ) =
  1910 + if get_file_times(filename) is
  1911 + {
  1912 + failure then println("FAILED to get get_file_times() for file '" + filename + "'"); to_ascii(sha1((filename, size))),
  1913 + success(ftimes) then to_ascii(sha1((filename, ftimes, size)))
  1914 + }.
  1915 +
  1916 +define Bool
  1917 + are_same_etag
  1918 + (
  1919 + Maybe(String) input_etag,
  1920 + String current_etag
  1921 + ) =
  1922 + if input_etag is
  1923 + {
  1924 + failure then println("input etag not found"); false,
  1925 + success(etag) then println("Input etag = " + etag); etag = current_etag
  1926 + }.
  1927 +
  1928 + Sending the answer line, the headers and the body.
  1929 +
  1930 +define One
  1931 + send_file
  1932 + (
  1933 + Web_Site_Description desc,
  1934 + Connection connection,
  1935 + List(HTTP_header) input_headers,
  1936 + List(HTTP_header) headers,
  1937 + Int32 size,
  1938 + Connection file,
  1939 + String filename,
  1940 + String full_path,
  1941 + String mime_type,
  1942 + One -> One action_before_send_file
  1943 + ) =
  1944 + action_before_send_file(unique);
  1945 + with input_etag = http_header_value(input_headers, "If-None-Match"),
  1946 + current_etag = compute_etag(full_path, size),
  1947 + if are_same_etag(input_etag, current_etag) is
  1948 + {
  1949 + false then
  1950 + forget(reliable_write(connection,to_byte_array("HTTP/1.1 200 OK"+crlf)));
  1951 + forget(reliable_write(connection,[format_headers(headers + headers_for_send_file(mime_type, size, current_etag)) , crlf]));
  1952 + send_file_body(desc,connection,file,size,0,filename),
  1953 + true then
  1954 + forget(reliable_write(connection,to_byte_array("HTTP/1.1 304 Not Modified"+crlf)));
  1955 + forget(reliable_write(connection,[format_headers([http_header("Etag", current_etag) . headers]) , crlf]))
  1956 + //send_file_body(desc,connection,file,size,0,filename)
  1957 + }.
  1958 +
  1959 +
  1960 +
  1961 + Checking if a connection is under SSL.
  1962 +
  1963 +define Bool
  1964 + is_SSL
  1965 + (
  1966 + Connection c
  1967 + ) =
  1968 + if c is
  1969 + {
  1970 + file_r(_) then false,
  1971 + file_w(_) then false,
  1972 + file_rw(_) then false,
  1973 + tcp(_) then false,
  1974 + ssl(_) then true
  1975 + }.
  1976 +
  1977 +
  1978 +
  1979 + Before opening and sending a file, we check the MIME type. It must be recognized,
  1980 + except if there is a valid authorization for private download.
  1981 +
  1982 +define One
  1983 + send_file
  1984 + (
  1985 + Web_Site_Description desc,
  1986 + Connection connection,
  1987 + String uri,
  1988 + List(HTTP_header) input_headers,
  1989 + Maybe(String) mbauthorization,
  1990 + One -> One action_before_send_file
  1991 + ) =
  1992 + if mbauthorization is
  1993 + {
  1994 + //--- file without authorization: take it from public ---
  1995 + failure then if recognize_mime_type_from_uri(desc,uri) is
  1996 + {
  1997 + failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"),
  1998 + success(mime_type) then
  1999 + with path = site_directory(desc)+"/public"+uri,
  2000 + if (Maybe(RStream))connect to file path is
  2001 + {
  2002 + failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"),
  2003 + success(f) then with size = file_size(f),
  2004 + send_file(desc,
  2005 + connection,
  2006 + input_headers,
  2007 + [],
  2008 + size,
  2009 + file(f),
  2010 + uri,
  2011 + path,
  2012 + mime_type,
  2013 + action_before_send_file)
  2014 + }
  2015 + },
  2016 +
  2017 + //--- file with authorization: apply 'private download' mecanism ---
  2018 + success(authorization) then
  2019 + with private_download_dir = site_directory(desc)+"/private_download",
  2020 + if (RetrieveResult(String))retrieve(private_download_dir+"/z"+authorization)
  2021 + is ok(absolute_path)
  2022 + then (
  2023 + with new_hash = compute_authorization(authorization_secret(desc),
  2024 + absolute_path),
  2025 + if (Maybe(RStream))connect to file absolute_path is
  2026 + {
  2027 + failure then log_journal_msg(desc,"Cannot find file '"+absolute_path+"'.\n"),
  2028 + success(f) then with size = file_size(f),
  2029 + mime_type = if recognize_mime_type_from_uri(desc,uri) is
  2030 + {
  2031 + failure then "application/octet-stream"
  2032 + success(mime_type) then mime_type
  2033 + },
  2034 + send_file(desc,
  2035 + connection,
  2036 + input_headers,
  2037 + [],
  2038 + size,
  2039 + file(f),
  2040 + uri,
  2041 + absolute_path,
  2042 + mime_type,
  2043 + action_before_send_file)
  2044 + }
  2045 + )
  2046 + else log_journal_msg(desc,"Cannot find or read authorization file.\n")
  2047 + }.
  2048 +
  2049 +
  2050 +
  2051 +
  2052 +
  2053 +
  2054 +
  2055 +
  2056 + *** [5.6] Answering a www-url encoded request.
  2057 +
  2058 + Standard headers are for answering ".awp" requests.
  2059 +
  2060 +define List(HTTP_header)
  2061 + standard_headers
  2062 + (
  2063 + Int32 answer_body_size,
  2064 + String charset
  2065 + ) =
  2066 + [
  2067 + //http_header("Content-Type","text/html"),
  2068 + http_header("Content-Type","text/html; charset="+charset),
  2069 + http_header("Content-length",integer_to_string(answer_body_size))
  2070 + ].
  2071 +
  2072 +
  2073 +define One
  2074 + www_url_answer
  2075 + (
  2076 + String host_name,
  2077 + Web_Site_Description desc,
  2078 + Connection connection, // with the client
  2079 + Int32 ip_addr, // of the client
  2080 + HTTP_RequestLine request_line,
  2081 + List(HTTP_header) headers,
  2082 + ByteArray body,
  2083 + One -> String generate_tt // trust ticket generation
  2084 + ) =
  2085 + with all_web_args = query_string(request_line) +
  2086 + read_www_url_encoded_web_args(to_string(body),0),
  2087 + uri = uri(request_line),
  2088 + ext = get_uri_extension(uri),
  2089 + (if member(journal_extensions(desc),ext)
  2090 + then log_journal_msg(desc,
  2091 + format_request(desc,connection,request_line,headers,all_web_args))
  2092 + else unique);
  2093 + if is_illegal_uri(uri,0)
  2094 + then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
  2095 + else (if (ext = ".awp" | ext = "")
  2096 + then (with answer_headers_body = awp_handler(desc)(host_name,
  2097 + http_info(ip_addr,uri,headers,generate_tt),
  2098 + all_web_args,
  2099 + is_SSL(connection)),
  2100 + if answer_headers_body is (additional_headers,answer_body) then
  2101 + forget(reliable_write(connection,
  2102 + [ "HTTP/1.1 200 OK", crlf,
  2103 + format_headers(standard_headers(length(answer_body),charset(desc))),
  2104 + format_headers(additional_headers),
  2105 + crlf .
  2106 + answer_body])))
  2107 + else (send_file(desc,
  2108 + connection,
  2109 + uri,
  2110 + headers,
  2111 + if web_arg_value(all_web_args,"zauth") is
  2112 + {
  2113 + not_found then failure,
  2114 + found(v) then success(v)
  2115 + },
  2116 + (One u) |-> before_send_file(desc)(all_web_args)))).
  2117 +
  2118 +
  2119 +
  2120 +
  2121 +
  2122 +
  2123 +
  2124 + *** [5.7] Answering a multipart/form-data encoded request.
  2125 +
  2126 + In order to support upload of files, we must be able to read web arguments which are
  2127 + encoded in a multipart/form-data body. The first thing to do is to find the
  2128 + boundary. The boundary is a special string which delimits the various parts of the
  2129 + 'multipart' body. It is found within the value of the 'Content-Type' HTTP header, as
  2130 + the value of the 'boundary' attribute.
  2131 +
  2132 +
  2133 +
  2134 +
  2135 +
  2136 + *** [5.7.1] Finding the boundary.
  2137 +
  2138 + Hence, we just have to find the string 'boundary=' within the value of the
  2139 + 'Content-Type' header, and read the value of the boundary from there.
  2140 +
  2141 +define Bool
  2142 + delimits_boundary
  2143 + (
  2144 + Word8 c
  2145 + ) =
  2146 + if c = ' ' then true else
  2147 + if c = 13 then true else
  2148 + if c = 10 then true else
  2149 + if c = 0 then true else
  2150 + if c = ',' then true else
  2151 + c = ';'.
  2152 +
  2153 +
  2154 +define Maybe(String)
  2155 + get_boundary_value_3
  2156 + (
  2157 + String s,
  2158 + Int32 i,
  2159 + List(Word8) so_far
  2160 + ) =
  2161 + if nth(i,s) is
  2162 + {
  2163 + failure then success(implode(reverse(so_far))),
  2164 + success(c) then
  2165 + if delimits_boundary(c)
  2166 + then success(implode(reverse(so_far)))
  2167 + else get_boundary_value_3(s,i+1,[c . so_far])
  2168 + }.
  2169 +
  2170 +
  2171 +
  2172 +define Maybe(String)
  2173 + get_boundary_value_2
  2174 + (
  2175 + String s,
  2176 + Int32 i,
  2177 + ) =
  2178 + if nth(i,s) is
  2179 + {
  2180 + failure then failure,
  2181 + success(c) then
  2182 + if is_blank(c)
  2183 + then get_boundary_value_2(s,i+1)
  2184 + else get_boundary_value_3(s,i+1,[c])
  2185 + }.
  2186 +
  2187 +define Maybe(String)
  2188 + get_boundary_value_1
  2189 + (
  2190 + String s, // string into which we must find '= ...'
  2191 + Int32 i // position of start of search
  2192 + ) =
  2193 + if nth(i,s) is
  2194 + {
  2195 + failure then failure,
  2196 + success(c) then
  2197 + if is_blank(c)
  2198 + then get_boundary_value_1(s,i+1)
  2199 + else if c = '='
  2200 + then get_boundary_value_2(s,i+1)
  2201 + else failure
  2202 + }.
  2203 +
  2204 +
  2205 +define Maybe(String)
  2206 + get_boundary
  2207 + (
  2208 + String content_type_header_value
  2209 + ) =
  2210 + if find("boundary",content_type_header_value,0) is
  2211 + {
  2212 + failure then failure,
  2213 + success(n) then // 'boundary' has been found at position n
  2214 + get_boundary_value_1(content_type_header_value,n+8)
  2215 + }.
  2216 +
  2217 +define Maybe(String)
  2218 + get_boundary
  2219 + (
  2220 + List(HTTP_header) headers
  2221 + ) =
  2222 + if headers is
  2223 + {
  2224 + [ ] then failure,
  2225 + [h . t] then if h is http_header(name,value) then
  2226 + if name = "content-type"
  2227 + then get_boundary(value)
  2228 + else get_boundary(t)
  2229 + }.
  2230 +
  2231 +
  2232 +
  2233 +
  2234 +
  2235 +
  2236 +
  2237 +
  2238 + *** [5.7.2] Reading attributes from a multipart entity.
  2239 +
  2240 + Entities in a multipart/form-data body are separated by instances of the string:
  2241 +
  2242 + --bbbbb
  2243 +
  2244 + where bbbbb is the boundary computed above. Actually, the body has the form:
  2245 +
  2246 + --bbbbb
  2247 + <entity 1>
  2248 + --bbbbb
  2249 + <entity 2>
  2250 + --bbbbb
  2251 + ...
  2252 + --bbbbb
  2253 + <last entity>
  2254 + --bbbbb
  2255 +
  2256 +
  2257 + We have to extract an entity which is in the body between offsets 'start' and 'end'
  2258 + (computed when boundaries have been localized). The entity itself is made of two parts:
  2259 + headers and body. The body is separated from the headers by a blank line. This blank
  2260 + line (a double crlf) marks the beginning of the body of the entity. Within the headers
  2261 + of the entity, we look for a 'Content-Disposition' header, which should look like this:
  2262 +
  2263 + Content-Disposition: form-data; name="..."; filename="..." crlf
  2264 +
  2265 + We are just interested in the name and the file name. Hence we first search
  2266 + 'Content-Disposition', then we search 'name' and read the value, and we do the same for
  2267 + 'filename'.
  2268 +
  2269 + If the 'filename' attribute is not present, the web arg is an ordinary one, otherwise,
  2270 + it is an uploaded file.
  2271 +
  2272 +
  2273 + Below is a variant of 'find' (see 'tools/findstring.anubis'), with an extra 'end'
  2274 + argument.
  2275 +
  2276 +define Maybe(Int32)
  2277 + find
  2278 + (
  2279 + String what,
  2280 + ByteArray where,
  2281 + Int32 start,
  2282 + Int32 end
  2283 + ) =
  2284 + if find(to_byte_array(what),where,start) is
  2285 + {
  2286 + failure then failure,
  2287 + success(n) then
  2288 + if n+length(what) >= end
  2289 + then failure
  2290 + else success(n)
  2291 + }.
  2292 +
  2293 +
  2294 +define String
  2295 + read_attribute_value
  2296 + (
  2297 + ByteArray where,
  2298 + Int32 start,
  2299 + Int32 end,
  2300 + List(Word8) so_far
  2301 + ) =
  2302 + if start >= end then implode(reverse(so_far)) else
  2303 + if nth(start,where) is
  2304 + {
  2305 + failure then implode(reverse(so_far)),
  2306 + success(c) then
  2307 + if c = '\"'
  2308 + then implode(reverse(so_far))
  2309 + else read_attribute_value(where,start+1,end,[c . so_far])
  2310 + }.
  2311 +
  2312 +define Maybe(String)
  2313 + find_attribute
  2314 + (
  2315 + String name,
  2316 + ByteArray where,
  2317 + Int32 start,
  2318 + Int32 end
  2319 + ) =
  2320 + with name = name+"=\"",
  2321 + if find(to_byte_array(name),where,start) is
  2322 + {
  2323 + failure then failure,
  2324 + success(n) then
  2325 + if n+length(name) >= end
  2326 + then failure
  2327 + else success(read_attribute_value(where,n+length(name),end,[]))
  2328 + }.
  2329 +
  2330 +
  2331 +
  2332 +define Maybe((String,Maybe(String)))
  2333 + find_name_and_filename
  2334 + (
  2335 + ByteArray body,
  2336 + Int32 start,
  2337 + Int32 end
  2338 + ) =
  2339 + if find(to_byte_array("Content-Disposition"),body,start) is
  2340 + {
  2341 + failure then failure,
  2342 + success(n) then
  2343 + if find_attribute("name",body,n+19,end) is
  2344 + {
  2345 + failure then failure,
  2346 + success(name_value) then if find_attribute("filename",body,n+19,end) is
  2347 + {
  2348 + failure then success((name_value,failure)),
  2349 + success(filename_value) then success((name_value,success(filename_value)))
  2350 + }
  2351 + }
  2352 + }.
  2353 +
  2354 +
  2355 +
  2356 +
  2357 +
  2358 +
  2359 +
  2360 +
  2361 +
  2362 +
  2363 + *** [5.7.3] Creating a temporary filename for an uploaded file.
  2364 +
  2365 +variable Int32 uploaded_file_count = 0.
  2366 +
  2367 + This variable is local to the virtual machine. Hence, its value is 0 each time a new
  2368 + requests arrives. Temporary uploaded files are stored in the directory represented by
  2369 + 'upload_temporary_directory'. The filenames have the form:
  2370 +
  2371 + _m_n
  2372 +
  2373 + where 'm' is the number of the virtual machine, and 'n' a number obtained by
  2374 + incrementing 'uploaded_file_count'. Notice that the program must do something with this
  2375 + file (move it to some directory/name), otherwise, it will probably be overwritten the
  2376 + next time the same machine works.
  2377 +
  2378 +
  2379 +
  2380 +
  2381 +
  2382 +
  2383 + *** [5.7.4] Saving an uploaded file under a temporary filename.
  2384 +
  2385 +define Maybe(String) // returns the temporary file name
  2386 + save_uploaded_file
  2387 + (
  2388 + Web_Site_Description desc,
  2389 + ByteArray body,
  2390 + Int32 start,
  2391 + Int32 end
  2392 + ) =
  2393 + uploaded_file_count <- 1 + *uploaded_file_count;
  2394 + with tfn = "_"+integer_to_string(virtual_machine_id)+"_"+integer_to_string(*uploaded_file_count),
  2395 + if (Maybe(WStream))connect to file site_directory(desc)+"/upload_temporary/"+tfn is
  2396 + {
  2397 + failure then failure,
  2398 + success(f) then
  2399 + if reliable_write(file(f),extract(body,start,end)) is
  2400 + {
  2401 + failure then failure,
  2402 + success(nw) then
  2403 + if nw = end - start
  2404 + then success(tfn)
  2405 + else failure
  2406 + }
  2407 + }.
  2408 +
  2409 +
  2410 +
  2411 +
  2412 +
  2413 +
  2414 +
  2415 +
  2416 + *** [5.7.5] Removing the path from a file name.
  2417 +
  2418 + When a file is uploaded, the browser sends the complete path of the file on the client
  2419 + machine as the file name. Actually, this is not quite normal. Nevertheless, we need to
  2420 + remove the path, and keep only the file name. This is achieved by 'remove_path' below.
  2421 +
  2422 +define Int32
  2423 + file_name_begin
  2424 + (
  2425 + String full_name,
  2426 + Int32 i
  2427 + ) =
  2428 + if nth(i,full_name) is
  2429 + {
  2430 + failure then 0,
  2431 + success(c) then
  2432 + if c = '/' then i+1 else
  2433 + if c = '\\' then i+1 else
  2434 + file_name_begin(full_name,i-1)
  2435 + }.
  2436 +
  2437 +define String
  2438 + remove_path
  2439 + (
  2440 + String full_name
  2441 + ) =
  2442 + with l = length(full_name),
  2443 + b = file_name_begin(full_name,l-1),
  2444 + substr(full_name,b,l-b).
  2445 +
  2446 +
  2447 +
  2448 +
  2449 +
  2450 + *** [5.7.6] Reading a multipart entity.
  2451 +
  2452 +define Maybe(Web_arg)
  2453 + get_multipart_entity
  2454 + (
  2455 + Web_Site_Description desc,
  2456 + ByteArray body,
  2457 + Int32 start,
  2458 + Int32 end
  2459 + ) =
  2460 + if find(to_byte_array(crlf+crlf),body,start) is
  2461 + {
  2462 + failure then failure,
  2463 + success(k) then
  2464 + if k >= end // must be within this entity, not the next one
  2465 + then failure
  2466 + else if find_name_and_filename(body,start,k) is
  2467 + {
  2468 + failure then failure,
  2469 + success(n_mbfn) then if n_mbfn is (name,mbfn) then
  2470 + if mbfn is
  2471 + {
  2472 + failure then
  2473 + success(web_arg(name,to_string(extract(body,k+4,end-2)))),
  2474 + // we must substract 2 to end because of crlf just before the boundary
  2475 +
  2476 + success(fn) then
  2477 + if save_uploaded_file(desc,body,k+4,end-2) is
  2478 + {
  2479 + failure then failure,
  2480 + success(tfn) then
  2481 + success(upload(name,remove_path(fn),
  2482 + site_directory(desc)+"/upload_temporary/"+tfn))
  2483 +
  2484 + }
  2485 + }
  2486 + }
  2487 + }.
  2488 +
  2489 +
  2490 +
  2491 +define List(Web_arg)
  2492 + read_multipart_form_data_encoded_web_args
  2493 + (
  2494 + Web_Site_Description desc,
  2495 + ByteArray body,
  2496 + ByteArray __boundary,
  2497 + Int32 i,
  2498 + ) =
  2499 + if find(__boundary,body,i) is
  2500 + {
  2501 + failure then [ ],
  2502 + success(n) then
  2503 + if find(__boundary,body,n+length(__boundary)) is
  2504 + {
  2505 + failure then [ ],
  2506 + success(m) then
  2507 + if get_multipart_entity(desc,body,n+length(__boundary),m) is
  2508 + {
  2509 + failure then [ ],
  2510 + success(wa) then
  2511 + [wa . read_multipart_form_data_encoded_web_args(desc,body,__boundary,m)]
  2512 + }
  2513 + }
  2514 + }.
  2515 +
  2516 +
  2517 +
  2518 +define One
  2519 + multipart_form_data_answer
  2520 + (
  2521 + String host_name,
  2522 + Web_Site_Description desc,
  2523 + Connection connection,
  2524 + Int32 ip_addr,
  2525 + HTTP_RequestLine request_line,
  2526 + List(HTTP_header) headers,
  2527 + ByteArray body,
  2528 + One -> String generate_tt
  2529 + ) =
  2530 + if get_boundary(headers) is
  2531 + {
  2532 + failure then unique,
  2533 + success(boundary) then
  2534 + with all_web_args = query_string(request_line) +
  2535 + read_multipart_form_data_encoded_web_args(desc,
  2536 + body,
  2537 + to_byte_array("--"+boundary),
  2538 + 0),
  2539 + uri = uri(request_line),
  2540 + ext = get_uri_extension(uri),
  2541 + log_journal_msg(desc,
  2542 + format_request(desc,connection,request_line,headers,all_web_args));
  2543 + if is_illegal_uri(uri,0)
  2544 + then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
  2545 + else
  2546 + if (ext = ".awp" | ext = "") then
  2547 + (with answer_headers_body = awp_handler(desc)(host_name,
  2548 + http_info(ip_addr,uri,headers,generate_tt),
  2549 + all_web_args,
  2550 + is_SSL(connection)),
  2551 + if answer_headers_body is (additional_headers,answer_body) then
  2552 + forget(reliable_write(connection,
  2553 + [ "HTTP/1.1 200 OK",crlf,
  2554 + format_headers(standard_headers(length(answer_body),charset(desc))),
  2555 + format_headers(additional_headers),
  2556 + crlf .
  2557 + answer_body])))
  2558 + else unique
  2559 + }.
  2560 +
  2561 +
  2562 +
  2563 +
  2564 +
  2565 +
  2566 +
  2567 +
  2568 + *** [5.8] Handling redirections.
  2569 +
  2570 + 'redirections' (of type 'List(Redirection)') contains redirection directives. Each one
  2571 + has the form:
  2572 +
  2573 + redirect(required_uri,required_host,corresponding_uri).
  2574 +
  2575 + The host required by the client may be found in the 'Host' HTTP header. The URI
  2576 + required by the client is given below as 'uri'. We just have to find the required host
  2577 + in the headers, and to find the corresponding redirection directive.
  2578 +
  2579 +
  2580 + In the next fonction, the required host and URI are known. We just have to search in
  2581 + the 'redirections' list.
  2582 +
  2583 +define String
  2584 + handle_redirection
  2585 + (
  2586 + String required_uri,
  2587 + String required_host,
  2588 + List(Redirection) redirections
  2589 + ) =
  2590 + if redirections is
  2591 + {
  2592 + [ ] then required_uri,
  2593 + [h . t] then if h is redirect(uri,host,target) then
  2594 + if host = required_host
  2595 + then if uri = required_uri
  2596 + then target
  2597 + else handle_redirection(required_uri,required_host,t)
  2598 + else handle_redirection(required_uri,required_host,t)
  2599 + }.
  2600 +
  2601 +
  2602 +
  2603 + The host name may be encumbered by a port number, like
  2604 +
  2605 + www.our-business.com:1607
  2606 +
  2607 + We must remove this port number, otherwise the host name may not be recognized.
  2608 +
  2609 +define String
  2610 + strip_port
  2611 + (
  2612 + String name,
  2613 + Int32 i
  2614 + ) =
  2615 + if nth(i,name) is
  2616 + {
  2617 + failure then name,
  2618 + success(c) then
  2619 + if c = ':'
  2620 + then substr(name,0,i)
  2621 + else strip_port(name,i+1)
  2622 + }.
  2623 +
  2624 +
  2625 +
  2626 +
  2627 +
  2628 + Finding the 'Host' header. No redirection is performed if this header is not found.
  2629 +
  2630 +define String
  2631 + handle_redirection // returns the redirected URI
  2632 + (
  2633 + List(Redirection) redirections,
  2634 + String uri, // original URI
  2635 + List(HTTP_header) headers
  2636 + ) =
  2637 + if headers is
  2638 + {
  2639 + [ ] then uri,
  2640 + [h . t] then if h is http_header(name,value) then
  2641 + if name = "host"
  2642 + then handle_redirection(uri,strip_port(value,0),redirections)
  2643 + else handle_redirection(redirections,uri,t)
  2644 + }.
  2645 +
  2646 +
  2647 +
  2648 +
  2649 +
  2650 +
  2651 +
  2652 +
  2653 + *** [5.9] Answering both sorts of requests.
  2654 +
  2655 + We must decide if the request is www-url encoded or multipart/form-data encoded. This
  2656 + is achieved through the header 'Content-Type'.
  2657 +
  2658 +define EncodingType
  2659 + get_encoding_type
  2660 + (
  2661 + List(HTTP_header) headers
  2662 + ) =
  2663 + if headers is
  2664 + {
  2665 + [ ] then www_url, // this is the default
  2666 + [h . t] then if h is http_header(name,value) then
  2667 + if name = "content-type"
  2668 + then if find("multipart/form-data",value,0) is
  2669 + {
  2670 + failure then www_url,
  2671 + success(_) then multipart_form_data
  2672 + }
  2673 + else get_encoding_type(t)
  2674 + }.
  2675 +
  2676 +
  2677 +
  2678 +define One
  2679 + send_answer
  2680 + (
  2681 + String host_name,
  2682 + Web_Site_Description desc,
  2683 + Connection connection,
  2684 + HTTP_RequestLine rqline,
  2685 + List(HTTP_header) headers,
  2686 + ByteArray body,
  2687 + One -> String generate_tt
  2688 + ) =
  2689 + if rqline is request_line(type,uri,qstring) then
  2690 + with rqline = request_line(type,handle_redirection(redirections(desc),uri,headers),qstring),
  2691 + if remote_IP_address_and_port(connection) is (ip_addr,_) then
  2692 + if get_encoding_type(headers) is
  2693 + {
  2694 + www_url then
  2695 + www_url_answer(host_name,desc,connection,ip_addr,rqline,headers,body,generate_tt),
  2696 + multipart_form_data then
  2697 + multipart_form_data_answer(host_name,desc,connection,ip_addr,rqline,headers,body,generate_tt)
  2698 + }.
  2699 +
  2700 +
  2701 +
  2702 +
  2703 +
  2704 +
  2705 +
  2706 + *** [6] The HTTP/HTTPS server.
  2707 +
  2708 + The command 'start_server' (declared in 'predefined.anubis') starts a virtual machine
  2709 + which opens a server TCP/IP connection, and which continuously listens to this
  2710 + connection. When a request arrives, this machine delegates the work of deciphering and
  2711 + answering the request to another virtual machine, and continues to listen. The job of
  2712 + the delegated machine is defined by the HTTP request handler below.
  2713 +
  2714 +
  2715 +
  2716 +
  2717 +
  2718 + *** [6.1] Determining the requested host.
  2719 +
  2720 + When a request arrives to one of our two servers, we must decide which site (host) is
  2721 + requested.
  2722 +
  2723 +define Maybe(String)
  2724 + get_host_header_value
  2725 + (
  2726 + List(HTTP_header) headers
  2727 + ) =
  2728 + if headers is
  2729 + {
  2730 + [ ] then failure,
  2731 + [h . t] then if h is http_header(name,value) then
  2732 + if name = "host"
  2733 + then success(strip_port(value,0))
  2734 + else get_host_header_value(t)
  2735 + }.
  2736 +
  2737 +define Maybe((String,Web_Site_Description))
  2738 + get_site
  2739 + (
  2740 + String requested_host,
  2741 + List(Web_Site_Description) sites
  2742 + ) =
  2743 + if sites is
  2744 + {
  2745 + [ ] then print("Requested host '"+requested_host+"' does not exist.\n"); failure,
  2746 + [site1 . others] then
  2747 + if site1 is web_site_description(common_names,_,_,_,_,_,_,_,_,_) then
  2748 + if member(common_names,requested_host)
  2749 + then success((requested_host,site1))
  2750 + else get_site(requested_host,others)
  2751 + }.
  2752 +
  2753 +
  2754 +define Maybe((String,Web_Site_Description))
  2755 + get_site
  2756 + (
  2757 + List(HTTP_header) headers,
  2758 + List(Web_Site_Description) sites
  2759 + ) =
  2760 + if get_host_header_value(headers) is
  2761 + {
  2762 + failure then print("No 'Host' HTTP header.\n"); failure,
  2763 + success(requested_host) then
  2764 + //here we treat the case with only one site. hence we accept any host request
  2765 + //print("*** there is " +length(sites) + " sites \n");
  2766 + if length(sites) = 1 then
  2767 + with site = force_nth(0, sites),
  2768 + //print("ONE server OK\n");
  2769 + success((requested_host, site))
  2770 + else
  2771 + get_site(requested_host,sites)
  2772 + }.
  2773 +
  2774 +
  2775 +
  2776 +
  2777 +
  2778 + *** [6.2] The HTTP request handler.
  2779 +
  2780 + Here is the HTTP/HTTPS handler. It is called at each new request in a separate virtual
  2781 + machine. It reads the headers of the HTTP request, determines the host, determines body
  2782 + size, reads the body of the HTTP request, and answers the request.
  2783 +
  2784 +
  2785 +
  2786 +define One -> String make_generate_trust_ticket(DenialOfService dos).
  2787 +
  2788 +
  2789 +define One
  2790 + http_https_handler
  2791 + (
  2792 + List(Web_Site_Description) sites,
  2793 + Connection connection,
  2794 + Bool is_https,
  2795 + DenialOfService dos
  2796 + ) =
  2797 + with start_time = (Int32)now,
  2798 + sttm <- start_time;
  2799 + if dos is denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
  2800 + if remote_IP_address_and_port(connection) is (ip_addr,port) then
  2801 + if read_request_line(connection,start_time+*rld_v,dos) is
  2802 + {
  2803 + error(msg) then print(format(msg)),
  2804 + ok(request_line) then
  2805 + if read_http_headers(connection,start_time+*hd_v,dos) is
  2806 + {
  2807 + error(msg) then print(format(msg)),
  2808 + ok(headers) then if get_site(headers,sites) is
  2809 + {
  2810 + failure then unique,
  2811 + success(p) then if p is (host_name,desc) then
  2812 + if get_body_size(headers) is
  2813 + {
  2814 + error(msg) then log_journal_msg(desc,format(msg)),
  2815 + ok(body_size) then
  2816 + if read_http_body(connection,body_size,constant_byte_array(0,0),1000) is
  2817 + {
  2818 + error(msg) then log_journal_msg(desc,format(msg)),
  2819 + ok(body) then
  2820 + send_answer(host_name,desc,connection,request_line,headers,body,
  2821 + make_generate_trust_ticket(dos))
  2822 + }
  2823 + }
  2824 + }
  2825 + }
  2826 + }.
  2827 +
  2828 +
  2829 + Below are the two tools for constructing the handlers required by 'start_server' and
  2830 + 'start_ssl_server' (see 'predefined.anubis').
  2831 +
  2832 +define Bool is_dubious_IP(Int32 ip, DenialOfService dos).
  2833 +
  2834 +define Server -> ((RWStream) -> One)
  2835 + make_http_handler
  2836 + (
  2837 + List(Web_Site_Description) sites,
  2838 + DenialOfService dos
  2839 + ) =
  2840 + (Server server) |-> (RWStream connection) |->
  2841 + if remote_IP_address_and_port(connection) is (addr,_) then
  2842 + if is_dubious_IP(addr,dos)
  2843 + then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
  2844 + else http_https_handler(sites,tcp(connection),false,dos).
  2845 +
  2846 +define Server -> (SSL_Connection -> One)
  2847 + make_https_handler
  2848 + (
  2849 + List(Web_Site_Description) sites,
  2850 + DenialOfService dos
  2851 + ) =
  2852 + (Server server) |-> (SSL_Connection connection) |->
  2853 + http_https_handler(sites,ssl(connection),true,dos).
  2854 +
  2855 +
  2856 +
  2857 +
  2858 + *** [6.3] Server's tasks.
  2859 +
  2860 + Some tasks must be executed periodically, for example for cleaning up directories from
  2861 + short life time files.
  2862 +
  2863 + The next function removes from the given directory (and recursively from its
  2864 + subdirectories) all the files which are more than 10 minutes old.
  2865 +
  2866 +define One
  2867 + cleanup_directory_10mn
  2868 + (
  2869 + String dir // path of private download directory (or subdirectory) with trailing slash
  2870 + ) =
  2871 + forget(map((FileDescription fd) |-> if fd is
  2872 + {
  2873 + no_info(name) then forget(remove(dir+name)),
  2874 + file(name,_,_,d) then if d+600 < now then forget(remove(dir+name)) else unique,
  2875 + link(name,_,_,d) then if d+600 < now then forget(remove(dir+name)) else unique,
  2876 + directory(name,_,_) then cleanup_directory_10mn(dir+name+"/"),
  2877 + },
  2878 + directory_full_list(dir,"*","*","*"))).
  2879 +
  2880 +
  2881 +define One
  2882 + http_servers_tasks
  2883 + (
  2884 + List(Web_Site_Description) sites,
  2885 + List(Server) servers,
  2886 + Int32 period,
  2887 + Int32 next_time,
  2888 + ) =
  2889 + if mapand(is_down,servers)
  2890 + then unique
  2891 + else if now > next_time
  2892 + then
  2893 + (
  2894 + /*
  2895 + forget(map((Web_Site_Description wsd) |->
  2896 + cleanup_directory_10mn(site_directory(wsd)+"/private_download/"),
  2897 + sites));
  2898 + */
  2899 + http_servers_tasks(sites,servers,period,next_time+period)
  2900 + )
  2901 + else
  2902 + (
  2903 + sleep(1000);
  2904 + http_servers_tasks(sites,servers,period,next_time)
  2905 + ).
  2906 +
  2907 +
  2908 +public define One
  2909 + start_http_servers_tasks
  2910 + (
  2911 + List(Web_Site_Description) sites,
  2912 + List(Server) servers,
  2913 + Int32 period
  2914 + ) =
  2915 + delegate http_servers_tasks(sites,servers,period,now),
  2916 + unique.
  2917 +
  2918 +
  2919 +
  2920 +
  2921 + *** [6.4] Protection against 'denial of service' attacks.
  2922 +
  2923 +
  2924 + *** [6.4.1] Counting connections.
  2925 +
  2926 +define Bool // returns false if the counter cannot be incremented (too many connections)
  2927 + increment_connections_counter
  2928 + (
  2929 + Var(Int32) counter
  2930 + ) =
  2931 + protect with n = *counter,
  2932 + if n >= 100
  2933 + then false
  2934 + else (counter <- (*counter)+1); true.
  2935 +
  2936 +define One
  2937 + decrement_connections_counter
  2938 + (
  2939 + Var(Int32) counter
  2940 + ) =
  2941 + protect counter <- (*counter)-1.
  2942 +
  2943 +
  2944 +
  2945 +
  2946 +
  2947 + *** [6.4.2] Recording dubious IP addresses.
  2948 +
  2949 +
  2950 +define List(DubiousIP)
  2951 + record_dubious_IP
  2952 + (
  2953 + Int32 ip,
  2954 + List(DubiousIP) l
  2955 + ) =
  2956 + if l is
  2957 + {
  2958 + [ ] then [dubious_ip(ip,now)],
  2959 + [h . t] then if h is dubious_ip(addr,time) then
  2960 + if addr = ip
  2961 + then [dubious_ip(addr,now) . t]
  2962 + else [h . record_dubious_IP(ip,t)]
  2963 + }.
  2964 +
  2965 +
  2966 +define One
  2967 + record_dubious_IP
  2968 + (
  2969 + Int32 dubious_IP,
  2970 + Var(List(DubiousIP)) v
  2971 + ) =
  2972 + protect v <- record_dubious_IP(dubious_IP,*v).
  2973 +
  2974 +
  2975 +define One
  2976 + record_dubious_IP
  2977 + (
  2978 + Int32 addr,
  2979 + DenialOfService dos
  2980 + ) =
  2981 + record_dubious_IP(addr,list_of_dubious(dos)).
  2982 +
  2983 +
  2984 +public define DenialOfService
  2985 + load_denial_of_service_info
  2986 + =
  2987 + if (RetrieveResult(DenialOfService))retrieve(my_anubis_directory+"/web_sites/dos_info") is
  2988 + ok(dos) then dos else denial_of_service(
  2989 + var(100),
  2990 + var(1000),
  2991 + var(1500),
  2992 + var(2000),
  2993 + var([]),
  2994 + var([])).
  2995 +
  2996 +
  2997 +
  2998 +
  2999 + *** [6.4.3] Testing if an address is dubious.
  3000 +
  3001 +define Bool
  3002 + is_dubious_IP
  3003 + (
  3004 + Int32 ip,
  3005 + List(DubiousIP) l
  3006 + ) =
  3007 + if l is
  3008 + {
  3009 + [ ] then false,
  3010 + [h . t] then if h is dubious_ip(addr,time) then
  3011 + if ip = addr
  3012 + then true
  3013 + else is_dubious_IP(ip,t)
  3014 + }.
  3015 +
  3016 +
  3017 +define Bool
  3018 + is_dubious_IP
  3019 + (
  3020 + Int32 ip,
  3021 + DenialOfService dos
  3022 + ) =
  3023 + if dos is
  3024 + {
  3025 + denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
  3026 + if member(*ra_v,ip) then false else
  3027 + is_dubious_IP(ip,*ld_v)
  3028 + }.
  3029 +
  3030 +
  3031 +
  3032 +
  3033 + *** [6.4.4] Removing inactive dubious IP addresses.
  3034 +
  3035 +define List(DubiousIP)
  3036 + remove_inactive_dubious_IP
  3037 + (
  3038 + List(DubiousIP) l,
  3039 + Int32 ref_time,
  3040 + ) =
  3041 + if l is
  3042 + {
  3043 + [ ] then [ ],
  3044 + [h . t] then if h is dubious_ip(addr,time) then
  3045 + if time < ref_time
  3046 + then (print(ip_addr_to_string(addr)+" removed from dubious addresses list.\n");
  3047 + remove_inactive_dubious_IP(t,ref_time))
  3048 + else [h . remove_inactive_dubious_IP(t,ref_time)]
  3049 + }.
  3050 +
  3051 +define One
  3052 + remove_inactive_dubious_IP
  3053 + (
  3054 + Var(List(DubiousIP)) v
  3055 + ) =
  3056 + protect
  3057 + with ref_time = now - 600, // 10 minutes
  3058 + v <- remove_inactive_dubious_IP(*v,ref_time).
  3059 +
  3060 +
  3061 + The above function will be executed periodically by the servers's tasks machine.
  3062 +
  3063 +
  3064 +
  3065 + *** [6.4.5] Making the function for generating trust tickets.
  3066 +
  3067 +define One -> String
  3068 + make_generate_trust_ticket
  3069 + (
  3070 + DenialOfService dos
  3071 + ) =
  3072 + (One _) |-> "".
  3073 +
  3074 +
  3075 +
  3076 +
  3077 +
  3078 +
  3079 +
  3080 + *** [6.5] Starting the HTTP/HTTPS server.
  3081 +
  3082 +
  3083 + The next function creates the directories for all sites (if they don't already exist).
  3084 +
  3085 +define One
  3086 + create_directories
  3087 + (
  3088 + List(Web_Site_Description) sites
  3089 + ) =
  3090 + if sites is
  3091 + {
  3092 + [ ] then unique,
  3093 + [s1 . others] then
  3094 + with site_dir = site_directory(s1),
  3095 + forget(make_directory(site_dir+"/public",default_directory_mode));
  3096 + forget(make_directory(site_dir+"/upload_temporary",default_directory_mode));
  3097 + forget(make_directory(site_dir+"/private_download",default_directory_mode));
  3098 + forget(make_directory(site_dir+"/journal",default_directory_mode));
  3099 + create_directories(others)
  3100 + }.
  3101 +
  3102 +
  3103 +
  3104 +
  3105 +
  3106 + Below are the commands for starting an HTTP server and an HTTPS server.
  3107 +
  3108 +
  3109 +define StartServerResult
  3110 + start_http_server
  3111 + (
  3112 + Int32 ip_address,
  3113 + Int32 port,
  3114 + Server -> ((RWStream) -> One) handler,
  3115 + Int32 retries,
  3116 + DenialOfService dos
  3117 + ) =
  3118 + if start_server(ip_address,
  3119 + port,
  3120 + handler,
  3121 + identity) is ok(server)
  3122 + then print(" \r");
  3123 + ok(server)
  3124 + else print("Port "+port+": retry number "+retries+"\r");
  3125 + sleep(1000);
  3126 + start_http_server(ip_address,port,handler,retries+1,dos).
  3127 +
  3128 +public define StartServerResult
  3129 + start_http_server
  3130 + (
  3131 + Int32 ip_address,
  3132 + Int32 port,
  3133 + List(Web_Site_Description) sites,
  3134 + DenialOfService dos
  3135 + ) =
  3136 + create_directories(sites);
  3137 + start_http_server(ip_address,port,
  3138 + make_http_handler(sites,dos),
  3139 + 0,
  3140 + dos).
  3141 +
  3142 +
  3143 + For the HTTPS server, we have a problem which is due to the fact that 'anbexec' is not
  3144 + yet able to manipulate several SSL server certificates. 'anbexec' and
  3145 + 'predefined.anubis' must be changed. Sorry ! This will be done as soon as possible. The
  3146 + 'solution' for the time being is to provide the common name of the unique SSL server
  3147 + certificate.
  3148 +
  3149 +
  3150 +define StartServerResult
  3151 + start_https_server
  3152 + (
  3153 + Int32 ip_address,
  3154 + Int32 port,
  3155 + String certificate_common_name,
  3156 + Server -> (SSL_Connection -> One) handler,
  3157 + Int32 retries,
  3158 + DenialOfService dos
  3159 + ) =
  3160 + if start_ssl_server(ip_address,
  3161 + port,
  3162 + certificate_common_name,
  3163 + handler,
  3164 + identity) is ok(server)
  3165 + then print(" \r");
  3166 + ok(server)
  3167 + else print("Port "+port+": retry number "+retries+"\r");
  3168 + sleep(1000);
  3169 + start_https_server(ip_address,port,
  3170 + certificate_common_name,
  3171 + handler,retries+1,
  3172 + dos).
  3173 +
  3174 +
  3175 +public define StartServerResult
  3176 + start_https_server
  3177 + (
  3178 + Int32 ip_address,
  3179 + Int32 port,
  3180 + String certificate_common_name, // of SSL server certificate
  3181 + List(Web_Site_Description) sites,
  3182 + DenialOfService dos
  3183 + ) =
  3184 + create_directories(sites);
  3185 + start_https_server(ip_address,port,certificate_common_name,
  3186 + make_https_handler(sites,dos),
  3187 + 0,dos).
  3188 +
  3189 +
  3190 +
  3191 +
  3192 +
  3193 +
  3194 +
  3195 +
  3196 +
  3197 + *** [7] The web dispatcher.
  3198 +
  3199 +
  3200 + *** [7.1] The dispatcher server.
  3201 +
  3202 +define One
  3203 + send_dispatching_page
  3204 + (
  3205 + RWStream conn,
  3206 + String common_name,
  3207 + Int32 port
  3208 + ) =
  3209 + print("Dispatching '"+common_name+"' to port "+port+"\n");
  3210 + forget(reliable_write(conn,to_byte_array(
  3211 + "<html><head><meta http-equiv=\"Refresh\" content=\"0;URL="+
  3212 + "http://"+common_name+":"+port+"/"+
  3213 + "\"></head><body></body></html>"
  3214 + ))).
  3215 +
  3216 +
  3217 +
  3218 +define Maybe(DispatcherInfo)
  3219 + find_host
  3220 + (
  3221 + List(DispatcherInfo) l,
  3222 + String host
  3223 + ) =
  3224 + if l is
  3225 + {
  3226 + [ ] then failure,
  3227 + [h . t] then if h is site(name,port) then
  3228 + if name = host
  3229 + then success(h)
  3230 + else find_host(t,host)
  3231 + }.
  3232 +
  3233 +
  3234 +
  3235 +define Server -> ((RWStream) -> One)
  3236 + make_dispatcher_handler
  3237 + (
  3238 + Var(List(DispatcherInfo)) info_v,
  3239 + DenialOfService dos
  3240 + ) =
  3241 + (Server server) |-> (RWStream conn) |->
  3242 + with start_time = (Int32)now,
  3243 + if read_request_line(tcp(conn),start_time+*request_line_delay(dos),dos) is
  3244 + {
  3245 + error(msg) then print(format(msg)),
  3246 + ok(request_line) then
  3247 + if read_http_headers(tcp(conn),start_time+*headers_delay(dos),dos) is
  3248 + {
  3249 + error(msg) then print(format(msg)),
  3250 + ok(headers) then if get_host_header_value(headers) is
  3251 + {
  3252 + failure then print("No 'HOST' HTTP header.\n"),
  3253 + success(host) then
  3254 + if find_host(*info_v,host) is
  3255 + {
  3256 + failure then print("Host: '"+host+"' not registered.\n"),
  3257 + success(s) then if s is site(common_name,ip_port) then
  3258 + send_dispatching_page(conn,common_name,ip_port)
  3259 + }
  3260 + }
  3261 + }
  3262 + }.
  3263 +
  3264 +
  3265 +define One
  3266 + dispatcher_update_error
  3267 + (
  3268 + String file_path
  3269 + ) =
  3270 + print("web_dispatcher: unable to reread file: '"+file_path+"'.\n").
  3271 +
  3272 +
  3273 +define Bool
  3274 + dispatcher_update_data
  3275 + (
  3276 + String info_file_path,
  3277 + Var(List(DispatcherInfo)) info_v,
  3278 + Var(Int32) info_date_v
  3279 + ) =
  3280 + if directory_full_list(my_anubis_directory+"/web_sites","dispatcher.info","","") is
  3281 + {
  3282 + [ ] then false,
  3283 + [h . t] then if h is
  3284 + {
  3285 + no_info(n) then false,
  3286 + file(n,_,_,d) then if n = "dispatcher.info"
  3287 + then (info_date_v <- d;
  3288 + if (RetrieveResult(List(DispatcherInfo)))retrieve(info_file_path) is
  3289 + {
  3290 + cannot_find_file then false,
  3291 + read_error then false,
  3292 + type_error then false,
  3293 + ok(info) then info_v <- info; true
  3294 + })
  3295 + else false,
  3296 + link(_,_,_,_) then false,
  3297 + directory(_,_,_) then false
  3298 + }
  3299 + }.
  3300 +
  3301 +
  3302 +
  3303 + The loop within which the dispatcher updates its data every 3 seconds:
  3304 +
  3305 +define One
  3306 + dispatcher_update_task
  3307 + (
  3308 + String info_file_path,
  3309 + Var(List(DispatcherInfo)) info_v,
  3310 + Var(Int32) info_date_v
  3311 + ) =
  3312 + sleep(3000);
  3313 + (if dispatcher_update_data(info_file_path,info_v,info_date_v)
  3314 + then unique
  3315 + else dispatcher_update_error(info_file_path));
  3316 + dispatcher_update_task(info_file_path,info_v,info_date_v).
  3317 +
  3318 +
  3319 +public define One
  3320 + start_web_dispatcher
  3321 + (
  3322 + Int32 ip_address, // address for listening (typically 0: listen on all interfaces)
  3323 + Int32 http_port, // typically 80
  3324 + DenialOfService dos
  3325 + ) =
  3326 + with info_file_path = my_anubis_directory+"/web_sites/dispatcher.info",
  3327 + info_v = var((List(DispatcherInfo))[]),
  3328 + info_date_v = var((Int32)0),
  3329 + if dispatcher_update_data(info_file_path,info_v,info_date_v)
  3330 + then if start_server(ip_address,
  3331 + http_port,
  3332 + make_dispatcher_handler(info_v,dos),
  3333 + (One u)|->u) is
  3334 + {
  3335 + cannot_create_the_socket then
  3336 + print("Cannot create the socket for HTTP server.\n"),
  3337 + cannot_bind_to_port then
  3338 + print("Cannot bind HTTP server to port "+http_port+".\n"),
  3339 + cannot_listen_on_port then
  3340 + print("HTTP server cannot listen on port "+http_port+".\n"),
  3341 + ok(http_server) then
  3342 + dispatcher_update_task(info_file_path,info_v,info_date_v)
  3343 + }
  3344 + else dispatcher_update_error(info_file_path).
  3345 +
  3346 +
  3347 +
  3348 + *** [7.2] The dispatcher web site.
  3349 +
  3350 + global define One
  3351 + web_dispatcher
  3352 + (
  3353 + List(String) args
  3354 + ) =
  3355 + start_web_dispatcher(0,80,load_denial_of_service_info).
  3356 +
  3357 +
  3358 +
  3359 +
  3360 +
  3361 +
  3362 + *** [7.3] Managing the info file.
  3363 +
  3364 +define Int32
  3365 + register_ip_address
  3366 + =
  3367 + if ip_address(prompt(" numerical IP address (for HTTP): ")) is
  3368 + {
  3369 + failure then print(" *** Error: incorrect IP address.\n");
  3370 + register_ip_address,
  3371 + success(n) then n
  3372 + }.
  3373 +
  3374 +
  3375 +define Int32
  3376 + register_ip_port
  3377 + =
  3378 + if string_to_integer(prompt(" IP port (for HTTP): ")) is
  3379 + {
  3380 + failure then print(" *** Error: incorrect IP port.\n");
  3381 + register_ip_port,
  3382 + success(p) then if (0 =< p & p =< 65535)
  3383 + then p
  3384 + else print(" *** Error: IP port out of bounds.\n");
  3385 + register_ip_port
  3386 + }.
  3387 +
  3388 +
  3389 +define One
  3390 + register_new_site
  3391 + (
  3392 + Var(List(DispatcherInfo)) info_v
  3393 + ) =
  3394 + print("\n");
  3395 + print(" Registering a new site:\n");
  3396 + with name = prompt(" Site name: "),
  3397 + with addr = register_ip_address,
  3398 + with port = register_ip_port,
  3399 + (protect info_v <- [site(name,port) . *info_v]);
  3400 + print(" Site "+name+" at "+ip_addr_to_string(addr)+":"+port+" added\n (but not saved to disk).\n").
  3401 +
  3402 +
  3403 +define List(DispatcherInfo)
  3404 + find_sites
  3405 + (
  3406 + List(DispatcherInfo) l,
  3407 + String name
  3408 + ) =
  3409 + if l is
  3410 + {
  3411 + [ ] then [ ],
  3412 + [h . t] then if h is site(n,_) then
  3413 + if find(name,n,0) is
  3414 + {
  3415 + failure then find_sites(t,name),
  3416 + success(_) then [h . find_sites(t,name)]
  3417 + }
  3418 + }.
  3419 +
  3420 +
  3421 +define String
  3422 + pad
  3423 + (
  3424 + String s,
  3425 + Int32 l
  3426 + ) =
  3427 + if length(s) >= l
  3428 + then s
  3429 + else s+constant_string(l-length(s),' ').
  3430 +
  3431 +
  3432 +
  3433 +define One
  3434 + show_sites_1
  3435 + (
  3436 + List(DispatcherInfo) l,
  3437 + Int32 i
  3438 + ) =
  3439 + if l is
  3440 + {
  3441 + [ ] then unique,
  3442 + [h . t] then if h is site(name,port) then
  3443 + print(" ["+i+"] "+pad(name,40)+" "+" "+port+"\n");
  3444 + show_sites_1(t,i+1)
  3445 + }.
  3446 +
  3447 +
  3448 +define One
  3449 + show_sites
  3450 + (
  3451 + List(DispatcherInfo) l,
  3452 + Int32 i
  3453 + ) =
  3454 + print(" Name Port\n");
  3455 + print(" --------------------------------------------------------\n");
  3456 + show_sites_1(l,i).
  3457 +
  3458 +define List(DispatcherInfo)
  3459 + replace_info
  3460 + (
  3461 + List(DispatcherInfo) l,
  3462 + String site_name,
  3463 + Int32 new_port
  3464 + ) =
  3465 + if l is
  3466 + {
  3467 + [ ] then alert,
  3468 + [h . t] then if h is site(n,_) then
  3469 + if n = site_name
  3470 + then [site(n,new_port) . t]
  3471 + else [h . replace_info(t,site_name,new_port)]
  3472 + }.
  3473 +
  3474 +define List(DispatcherInfo)
  3475 + delete_info
  3476 + (
  3477 + List(DispatcherInfo) l,
  3478 + String site_name,
  3479 + ) =
  3480 + if l is
  3481 + {
  3482 + [ ] then alert,
  3483 + [h . t] then if h is site(n,_) then
  3484 + if n = site_name
  3485 + then t
  3486 + else [h . delete_info(t,site_name)]
  3487 + }.
  3488 +
  3489 +
  3490 +define One
  3491 + update_site
  3492 + (
  3493 + Var(List(DispatcherInfo)) info_v,
  3494 + String site_name,
  3495 + Int32 old_port
  3496 + ) =
  3497 + print("\n");
  3498 + print(" Updating site '"+site_name+"': (currently: "+old_port+")\n");
  3499 + with new_port = register_ip_port,
  3500 + answer = prompt(" Update '"+site_name+"' as: "+new_port+" [Y/N] ? "),
  3501 + if (answer = "Y" | answer = "y")
  3502 + then info_v <- replace_info(*info_v,site_name,new_port)
  3503 + else unique.
  3504 +
  3505 +
  3506 +
  3507 +define Bool
  3508 + compare
  3509 + (
  3510 + DispatcherInfo d1,
  3511 + DispatcherInfo d2
  3512 + ) =
  3513 + if d1 is site(n1,_) then
  3514 + if d2 is site(n2,_) then
  3515 + string_less(n1,n2).
  3516 +
  3517 +
  3518 +
  3519 +define One
  3520 + update_site
  3521 + (
  3522 + Var(List(DispatcherInfo)) info_v
  3523 + ) =
  3524 + print("\n");
  3525 + with prefix = prompt(" Search for site to update: "),
  3526 + if find_sites(*info_v,prefix) is
  3527 + {
  3528 + [ ] then print(" No site found.\n");
  3529 + update_site(info_v),
  3530 + [h . t] then
  3531 + show_sites(qsort([h . t],compare),1);
  3532 + with i1 = prompt(" Choose a site to update [1/.../"+(length(t)+1)+"]: "),
  3533 + if string_to_integer(i1) is
  3534 + {
  3535 + failure then print(" *** Error: site number not recognized.\n");
  3536 + update_site(info_v),
  3537 + success(ii1) then if nth(ii1-1,*info_v) is
  3538 + {
  3539 + failure then print(" *** Error: site number "+i1+" does not exist.\n");
  3540 + update_site(info_v),
  3541 + success(site_info) then if site_info is site(name,old_port) then
  3542 + update_site(info_v,name,old_port)
  3543 + }
  3544 + }
  3545 + }.
  3546 +
  3547 +
  3548 +define One
  3549 + delete_site
  3550 + (
  3551 + Var(List(DispatcherInfo)) info_v,
  3552 + String site_name,
  3553 + Int32 old_port
  3554 + ) =
  3555 + print("\n");
  3556 + print(" Deleting site '"+site_name+"': (currently: "+old_port+")\n");
  3557 + with answer = prompt(" Are you sure you want to delete site: '"+site_name+"' [Y/N] ? "),
  3558 + if (answer = "Y" | answer = "y")
  3559 + then info_v <- delete_info(*info_v,site_name)
  3560 + else print(" Site '"+site_name+"' not deleted.\n").
  3561 +
  3562 +
  3563 +define One
  3564 + delete_site
  3565 + (
  3566 + Var(List(DispatcherInfo)) info_v
  3567 + ) =
  3568 + print("\n");
  3569 + with prefix = prompt(" Search for site to delete: "),
  3570 + if find_sites(*info_v,prefix) is
  3571 + {
  3572 + [ ] then print(" No site found.\n");
  3573 + delete_site(info_v),
  3574 + [h . t] then
  3575 + show_sites(qsort([h . t],compare),1);
  3576 + with i1 = prompt(" Choose a site to delete [1/.../"+(length(t)+1)+"]: "),
  3577 + if string_to_integer(i1) is
  3578 + {
  3579 + failure then print(" *** Error: site number not recognized.\n");
  3580 + delete_site(info_v),
  3581 + success(ii1) then if nth(ii1-1,*info_v) is
  3582 + {
  3583 + failure then print(" *** Error: site number "+i1+" does not exist.\n");
  3584 + delete_site(info_v),
  3585 + success(site_info) then if site_info is site(name,old_port) then
  3586 + delete_site(info_v,name,old_port)
  3587 + }
  3588 + }
  3589 + }.
  3590 +
  3591 +
  3592 +define One
  3593 + manager
  3594 + (
  3595 + Var(List(DispatcherInfo)) info_v,
  3596 + String file_path
  3597 + ) =
  3598 + print("\n");
  3599 + print(" --- Welcome to the Web Dispatcher Manager ---\n");
  3600 + with l = length(*info_v),
  3601 + print(" "+l+" site"+(if l>1 then "s" else "")+" currently registred.\n");
  3602 + print(" [L] List registered sites.\n");
  3603 + print(" [R] Register a new site.\n");
  3604 + print(" [U] Update a registred site.\n");
  3605 + print(" [D] Delete a registred site.\n");
  3606 + with propose_write_v = var((Bool)true),
  3607 + action = prompt(" Choose an action [L/R/U/D]: "),
  3608 + (if (action = "L" | action = "l") then (show_sites(*info_v,1); propose_write_v <- false) else
  3609 + if (action = "R" | action = "r") then register_new_site(info_v) else
  3610 + if (action = "U" | action = "u") then update_site(info_v) else
  3611 + if (action = "D" | action = "d") then delete_site(info_v) else
  3612 + print("Action not recognized.\n"));
  3613 + print("\n");
  3614 + if *propose_write_v then
  3615 + with result = prompt(" Write modifications to data base [Y/N] ?"),
  3616 + if (result = "Y" | result = "y")
  3617 + then if save(*info_v,file_path) is
  3618 + {
  3619 + cannot_open_file then print(" File '"+file_path+"' not found.\n"),
  3620 + write_error then print(" Error while writing file '"+file_path+"'.\n"),
  3621 + ok then print(" Data base has been modified.\n")
  3622 + }
  3623 + else print(" Data base not modified.\n")
  3624 + else unique.
  3625 +
  3626 +
  3627 +
  3628 +global define One
  3629 + manage_web_dispatcher
  3630 + (
  3631 + List(String) args
  3632 + ) =
  3633 + with info_v = var((List(DispatcherInfo))[]),
  3634 + with file_path = my_anubis_directory+"/web_sites/dispatcher.info",
  3635 + if (RetrieveResult(List(DispatcherInfo)))retrieve(file_path) is
  3636 + {
  3637 + cannot_find_file then print("File '"+file_path+"' does not exist.\n");
  3638 + with answer = prompt("Create it [Y/N] ? "),
  3639 + if (answer = "Y" | answer = "y")
  3640 + then if save((List(DispatcherInfo))[],file_path) is
  3641 + {
  3642 + cannot_open_file then
  3643 + print("Cannot create file '"+file_path+"'.\n"),
  3644 + write_error then
  3645 + print("Error while creating file '"+file_path+"'.\n"),
  3646 + ok then manager(info_v,file_path)
  3647 + }
  3648 + else unique,
  3649 + read_error then print("Error while reading file '"+file_path+"'.\n"),
  3650 + type_error then print("File '"+file_path+"' is corrupted.\n"),
  3651 + ok(info) then info_v <- info;
  3652 + manager(info_v,file_path)
  3653 + }.
  3654 +
  3655 +
  3656 +
  3657 +
  3658 +
... ...