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
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 +