Commit 027a26df369f5178fc8bfa94a110b241db60614f

Authored by David RENE
1 parent f45ea158

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

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