Anubis / Xlib

Commit 38d4c6fc6a1e397e8628bc070e0811ad6627618f

Authored by Cédric RICARD
1 parent ad603841

Only cosmetic

Showing 2 changed files with 7414 additions and 7411 deletions   Show diff stats
Inline Side-by-side
calexium_lib/web/CXM_making_a_web_site.anubis
  Show/Hide comments   View file @38d4c6f
Changes suppressed. Click to show
1   -
2   -
3   - *Project* Anubis
4   -
5   - *Title* Making interactive Web sites.
6   -
7   - *Copyright* Copyright (c) Alain Prouté 2004-2005.
8   -
9   -
10   - *Author* Alain Prouté
11   -
12   - *Revised* January 2005.
13   -
14   -
15   - *Overview*
16   -
17   - In this file we propose simple tools for making well structured interactive and secured
18   - web sites.
19   -
20   -
21   - ----------------------------------- Table of Contents ---------------------------------
22   -
23   - * (1) Structure of a web site.
24   - ** (1.1) Three sorts of data.
25   - ** (1.2) How requests are handled.
26   - ** (1.3) What web pages are made of.
27   - ** (1.4) Actions.
28   - ** (1.5) States.
29   -
30   - * (2) Carrying on.
31   - ** (2.1) Describing your web sites.
32   - ** (2.2) Directories on the server's disk.
33   - ** (2.3) Starting your web sites.
34   -
35   - * (3) The HTML interface.
36   - ** (3.1) Types used by the HTML interface.
37   - ** (3.2) ``in form'' versus ``off form''.
38   - ** (3.3) Defining your own style.
39   - ** (3.4) Actioners and forms.
40   - ** (3.5) Local popup.
41   -
42   - ---------------------------------------------------------------------------------------
43   -
44   -
45   -read tools/basis.anubis
46   -read CXM_common.anubis
47   -read CXM_multihost_http_server.anubis
48   -read CXM_mime.anubis
49   -
50   -
51   -
52   - * (1) Structure of a web site.
53   -
54   - First of all we need to explain what a web site should be made of. Ideally, the
55   - visitor (also called the 'client') should see the web site working as any other
56   - interactive computer software. So, it should be clear that a 'session' (i.e. a visit
57   - to the web site, including the consultation of several pages) is some kind of
58   - conversation between the visitor and the web site, and that the web site should
59   - maintain a 'current state' of this conversation. At each new request (click) from the
60   - visitor, this state must be updated. This whole conversation is called a 'session' and
61   - should not be confused with a single request.
62   -
63   -
64   -
65   - ** (1.1) Three sorts of data.
66   -
67   - All the data needed for putting a web site at work may be dispatched into three
68   - categories:
69   -
70   - 1. Constant data (data that never change). These data may be hard coded into the
71   - Anubis source files of the web site.
72   -
73   - 2. Permanent data (data which always exist independantly of the users connected to
74   - the web site). These data are normally recorded into data bases.
75   -
76   - 3. Session data (data which depend on a particular visitor and which exist only
77   - during the time he visits the web site). These data are stored into so-called
78   - 'states'.
79   -
80   -
81   - It is important to determine which data belongs to which category. This is part of your
82   - design decisions.
83   -
84   -
85   -
86   - ** (1.2) How requests are handled.
87   -
88   - We want to separate the following two functionalities (which are used at each request
89   - (click) during a single session):
90   -
91   - - computing the new state from the previous state and from the client request, and
92   - updating the data base,
93   -
94   - - computing the page to be sent to the client from the new current state and from
95   - the informations in the data base.
96   -
97   -
98   - The next picture shows the structure we have in mind:
99   -
100   -
101   - request +---------+ HTML page (with a hidden state name)
102   - .-------------------| client |<--------------.
103   - | .-----------------| | |
104   - | | previous state +---------+ |
105   - | | name (if any) |
106   - | | | client side
107   - ............................................................................
108   - | | | server side
109   - | | |
110   - | | .-------------------. |
111   - | | | previous state | |
112   - V V V | |
113   - +---------------+ +---------------+ +--------------+
114   - | compute state | | server's disk | | compute page |
115   - +---------------+ +---------------+ +--------------+
116   - ^ | | ^ ^ ^ ^ ^
117   - | | | | | | | |
118   - | | `--------------------+--------------------' | |
119   - | | new state | | |
120   - read | `------------------------+--------------------' |
121   - write | new state name |
122   - update V |
123   - +-----------+ |
124   - | data base |--------------------------------------------'
125   - +-----------+ read only
126   -
127   -
128   - When the client begins a session, there is no previous state. In this case, a default
129   - 'initial state' is used instead.
130   -
131   - The data base may be updated by 'compute state' box, but should not be update by the
132   - 'compute page' box. The 'compute page' box should be allowed only to read the data
133   - base.
134   -
135   - In this file, all the above stuff is defined, except the 'compute state' and 'compute
136   - page' boxes. You just have to provide the function for computing a new state (compute
137   - state) and the function for computing the page (compute page) from the new state. You
138   - don't have to worry about state names, saving and retrieving states and the like.
139   -
140   -
141   -
142   -
143   -
144   - ** (1.3) What web pages are made of.
145   -
146   - What the client can see in his browser's window may be called a 'page'. Within a page,
147   - we have several sorts of components:
148   -
149   - - 'local' components, i.e. all components which do not open a connection, like
150   - texts, images, etc... possibly using JavaScript programmation,
151   -
152   - - 'actioners', which, when clicked upon, open a connection with our web site; they
153   - may appear as links or buttons, etc...
154   -
155   - - 'foreign links', which when clicked upon, open a connection with another web site
156   - (or ours eventually).
157   -
158   - Of course, what an actioner does is just ask our web site to perform an action. To that
159   - end, the actioner essentially sends the name of the action to be performed. However, it
160   - may be necessary to provide additional informations which may be seen as 'operands' of
161   - the action. In order to attach operands to an action, HTML provides the notion of
162   - 'form'. Indeed, a form contains essentially a set of input fields into which the client
163   - may put values for the required operands of the action, and a submit button, which is
164   - the actioner itself. Notice that a single form may contain several submit buttons,
165   - which simply means that there are several distincts actions taking the same set of
166   - operands.
167   -
168   - Restrictions must be put on the use of all theses gadgets. Indeed, for example,
169   - putting a form within another form is officially meaningless in HTML, and the client's
170   - browser may be seriously disturbed by this. In this file, we propose an interface to
171   - the HTML language, which forbids such meaningless things, simply by imposing a strict
172   - typing of HTML concepts.
173   -
174   - Each web site may be accessible through two communication channels:
175   -
176   - - a non secured channel (HTTP),
177   - - a secured channel (HTTPS).
178   -
179   - Nevertheless, the whole thing should be considered as a single web site. For example,
180   - you may have a secured page, obtained through HTTPS, containing public images obtained
181   - through HTTP. An actioner in a non secured page may open a secured connection, and
182   - conversely.
183   -
184   - Summarizing, a web page is made of local elements, foreign links and actioners.
185   - Actioners receive operands from forms, and they also choose to communicate through the
186   - non secured or through the secured channel.
187   -
188   -
189   -
190   - +-------------------+
191   - | page |
192   - | | +---------------+
193   - | +--------------+ | | next page |
194   - | | form | | | (non secured) |
195   - | | +----------+ | | HTTP | |
196   - | | | actioner |---------------------------->| |
197   - | | +----------+ | | +---------------+
198   - | | | |
199   - | | +----------+ | | +---------------+
200   - | | | actioner |---------------------------->| next page |
201   - | | +----------+ | | HTTPS | (secured) |
202   - | | | | | |
203   - | +--------------+ | | |
204   - | | +---------------+
205   - | |
206   - +-------------------+
207   -
208   -
209   - Notice that actioners need no be necessarily put into forms. In that case, they work as
210   - ordinary links, but they still may receive operands as we shall see.
211   -
212   -
213   -
214   -
215   - ** (1.4) Actions.
216   -
217   - The client opens a new connection with our web site whenever he clicks on an
218   - actioner. The result is that a request is sent, essentially made of a list of 'web
219   - arguments'. Each web argument is a pair (name,value). One of these web arguments, the
220   - 'action' web argument (whose name is "a"), determines the action to be performed. The
221   - other web arguments (not including "s", used to identify the state) are the operands
222   - for this action.
223   -
224   - Hence, the 'compute state' box in the picture above, splits naturally into as many
225   - sub-boxes as there are actions. For this reason, we define the following type for
226   - representing actions (where '$State' is the type representing session informations):
227   -
228   -public type Web_Action($SessionTicket, $State):
229   - http_action (String name, // name of action
230   - (Maybe($State)) -> Bool allow, // true if action allowed
231   - (HTTP_Info http_info,
232   - List(Web_arg) web_args, // actually only 'operands' web arguments
233   - Maybe($State) state) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) do_it),
234   - https_action (String name, // name of action
235   - (Maybe($State)) -> Bool allow, // true if action allowed
236   - (HTTP_Info http_info,
237   - List(Web_arg) web_args, // actually only 'operands' web arguments
238   - Maybe($State) state) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) do_it),
239   - http_https_action (String name,
240   - (Maybe($State)) -> Bool allow, // true if action allowed
241   - (HTTP_Info http_info,
242   - List(Web_arg) web_args,
243   - Maybe($State) state) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) do_it).
244   -
245   - 'http_action's are executed only under HTTP, and 'https_action's are executed only
246   - under HTTPS. 'http_https_action's may be executed under both types of connections.
247   -
248   - Each action has a name, which is used to identify the action. Each action also has a
249   - function 'allow' whose job is to verify that the action is allowed in the current
250   - state, and a function 'do_it' for performing the action. The function 'do_it' receives
251   - a lot of informations:
252   -
253   - - 'HTTP informations':
254   - - the IP address of the client,
255   - - the URI requested by the client (after redirection),
256   - - the list of HTTP headers generated by the client's browser,
257   - - the list of web arguments sent by the client (except "s" and "a"),
258   - - the previous state (or the 'initial' or 'ticket expired' state if no previous
259   - state can be found).
260   -
261   - In most cases, HTTP informations are not used. This is the reason why they are gathered
262   - for simplicity into a unique datum of type 'HTTP_Info'.
263   -
264   -// For your convenience, we introduce the following simpler variants:
265   -//
266   -//public define Web_Action($State)
267   -// http_action
268   -// (
269   -// String name,
270   -// $State -> Bool allow,
271   -// (List(Web_arg),$State) -> $State do_it
272   -// ) =
273   -// http_action(name,
274   -// (Maybe($State) ms) |-> if ms is
275   -// {
276   -// failure then true,
277   -// success(s) then allow(s)
278   -// },
279   -// (HTTP_Info h, List(Web_arg) l, Maybe($State) s) |-> if s is
280   -// {
281   -// failure then (failure, []),
282   -// success(s2) then (success(do_it(l,s2)), [])
283   -// }).
284   -//
285   -//public define Web_Action($State)
286   -// https_action
287   -// (
288   -// String name,
289   -// $State -> Bool allow,
290   -// (List(Web_arg),$State) -> $State do_it
291   -// ) =
292   -// https_action(name,
293   -// (Maybe($State) ms) |-> if ms is
294   -// {
295   -// failure then true,
296   -// success(s) then allow(s)
297   -// },
298   -// (HTTP_Info h, List(Web_arg) l, Maybe($State) s) |-> if s is
299   -// {
300   -// failure then (failure, []),
301   -// success(s2) then (success(do_it(l,s2)), [])
302   -// }).
303   -//
304   -//public define Web_Action($State)
305   -// http_https_action
306   -// (
307   -// String name,
308   -// $State -> Bool allow,
309   -// (List(Web_arg),$State) -> $State do_it
310   -// ) =
311   -// http_https_action(name,
312   -// (Maybe($State) ms) |-> if ms is
313   -// {
314   -// failure then true,
315   -// success(s) then allow(s)
316   -// },
317   -// (HTTP_Info h, List(Web_arg) l, Maybe($State) s) |-> if s is
318   -// {
319   -// failure then (failure, []),
320   -// success(s2) then (success(do_it(l,s2)), [])
321   -// }).
322   -
323   -
324   -
325   - When you define your web site, you must provide the list of all the actions of the
326   - site. When a new state has been computed, a graphical representation of this state
327   - must be sent to the client. To that end, you must provide a function (named below
328   - 'compute_page') of type:
329   -
330   - $State -> HTML_Page
331   -
332   - where the type 'HTML_Page' (defined below in this file) abstractly represents HTML
333   - pages.
334   -
335   -public type HTML_Page:...
336   -
337   - It should be clear that states and pages are deeply linked together. Indeed, we really
338   - understand the page shown to the client as a representation of the current state of the
339   - conversation between the client and the web site, but also containing informations
340   - taken from the data bases.
341   -
342   -
343   -
344   -
345   -
346   - ** (1.5) States.
347   -
348   - Now, we explain how you can define the type (say 'State') to be used as an instance of
349   - the type parameter '$State'. The following is just a suggestion.
350   -
351   - Each state determines a page (since 'compute_page' computes a page from a
352   - state). However, some components of the state may be independant of the page. It may be
353   - the case for example for the indication of the natural language used by the
354   - client. Hence, a state should be made of (at least) two parts:
355   -
356   - - informations which are the same for all pages,
357   - - informations which are particular to each page.
358   -
359   - For example, you could define:
360   -
361   - type Page: // one alternative per page, with particular informations
362   - login(...), // in the components
363   - main_page(...),
364   - ...etc...
365   -
366   - Now, the type 'State' could be defined as follows:
367   -
368   - type State:
369   - state(Language, // informations valid for all pages
370   - ...,
371   - Page). // informations particular to a page
372   -
373   - However, if you are making a secured web site within which clients should be identified
374   - (by id and password), it may be a good idea to have two sorts of states, one for non
375   - identified clients and one for identified clients. In this case, define the type
376   - 'State' as follows (this is just a suggestion):
377   -
378   - type State:
379   - non_identified(Language),
380   - identified(String id,
381   - Language,
382   - Page).
383   -
384   - When a request arrives, check if the previous state is 'identified(...)' or
385   - 'non_identified(...)', and don't provide access to certain pages to non identified
386   - clients. This is required for security.
387   -
388   - Some more words on security. If your site needs to identify clients, define the
389   - initial state as 'non_identified(...)'. Construct a 'login' page, and check the id and
390   - password of the client. If the id and password are correct, then change the state of
391   - the client to 'identified(...)'. No other action should be able to do that. Now, be
392   - confident that clients cannot forge states. The only information they have is the name
393   - of a state, not the state itself which is never sent over the network, but only stored
394   - on the server's disk. The name of the state is constructed using strong cryptographical
395   - methods (sha1). If everything (since the 'login' page) is performed under HTTPS, even
396   - state names cannot be seen by a third party. So, if the system retrieves a previous
397   - state of the form 'identified(...)', you can be confident that your client is well
398   - identified, and you can send him confidential informations.
399   -
400   - States have a limited life time. It may happen that a client clicks on a button at a
401   - time its state is out of date. In this case, this system considers that the new state
402   - is a special state named 'ticket expired'. You must provide a function producing this
403   - state when you describe your web site. The page corresponding to this state must just
404   - inform the client that he/she waited a too long time before clicking on a button, and
405   - has to restart (a new conversation) from the begining.
406   -
407   -
408   -
409   - * (2) Carrying on.
410   -
411   - ** (2.1) Describing your web sites.
412   -
413   - Before you may start your web site, you must describe it, i.e. produce a datum of the
414   - opaque type 'Web_Site'.
415   -
416   -public type Web_Site:...
417   -
418   - Producing such a datum may be performed by:
419   -
420   -public define Web_Site
421   - make_web_site_description
422   - (
423   - List(String) common_names, // for example: ["www.our-business.com",
424   - // "192.168.0.1"]
425   - // the second one is just for testing
426   - String site_directory, // where 'public' and other directories are
427   - // located (should NOT end with '/')
428   - One -> One init,
429   - (HTTP_Info) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) initial_state,
430   - ($State expired,
431   - HTTP_Info,
432   - List(Web_arg),
433   - Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) ticket_expired_state,
434   - (HTTP_Info,
435   - List(Web_arg),
436   - Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) ticket_lost_state,
437   - List(Web_Action($SessionTicket, $State)) actions,
438   - (Maybe($SessionTicket), Maybe($State)) -> HTML_Page compute_page,
439   - Int32 timeout, // seconds (todo: minutes)
440   - List(Redirection) redirections,
441   - String charset,
442   - List(String) journal_extensions,
443   - List(String) journal_headers,
444   - String authorization_secret,
445   - List(MIME) known_mime_types,
446   - (String action_name,
447   - List(Web_arg) args)-> One before_send_file
448   - ).
449   -
450   -
451   - Explanations:
452   -
453   - 'common_names' is the list of names of the site (the name the browser must send as the
454   - value of the 'Host' HTTP header in order to access the site must be in that list). Such
455   - a name generally looks like this:
456   -
457   - www.somewhere.com
458   -
459   - If you are using HTTPS, you also have an 'X.509 SSL server certificate'. The name of
460   - the site must be exactly the same as the name on the certificate (which is precisely
461   - called the 'common name' in the X.509 jargon). If the two names do not match, the site
462   - will still work, but the transaction will not be transparent to the client. His browser
463   - will complain that the name of the certificate does not match the name of the site, and
464   - he will have to accept the certificate manually.
465   -
466   - 'site_directory' is the absolute path to the directory where the files needed by the
467   - site are located. Usually this directory looks like:
468   -
469   - my_anubis/web_sites/www.somewhere.com
470   -
471   - However, this information is not computed from 'common_name', so that you can change
472   - the common name (for example temporarily, for networking reasons) without loosing
473   - access to the files.
474   -
475   - 'ticket_expired_state(expired_state,http_info,lwa,is_https)' must produce the state
476   - whose graphical representation is a page explaining to the user that its 'ticket' (or
477   - 'session information') has expired, and that he/she must close all popup windows and
478   - start a new session. The arguments of the function contain the previous (expired)
479   - state and all current informations concerning the user. This arguments may be useful
480   - for example for producing the expiration message in the language chosen by the user.
481   - You can also (and this may be much smarter) send a 'ticket prolongation page'
482   - (including a new login for example), and resume the same conversation, since you have
483   - all the pertinent informations at hand. In the case the ticket is definitely lost, the
484   - second fonction 'ticket_lost_state' is used.
485   -
486   - Notice that despite the fact that the parameter $State is involved in the arguments of
487   - the above function, the type 'Web_Site' does not depend on this parameter. This allows
488   - to produce lists of web site descriptions, where each description may be constructed
489   - with a different instance of $State. This is required because distinct sites must have
490   - distinct types of session informations. This is made possible by the fact that the
491   - type is obscure, and the constructor replaced by a function which assembles
492   - 'ticket_expired_state', ticket_lost_state', 'actions' and 'compute_page' into a single
493   - entity not depending on $State. You should have a look to the private part of this file
494   - if you want more precisions about this programming technique.
495   -
496   - 'charset' is a string which will determine the character encoding to be used by the
497   - browser. Typically, this string is one of: "UTF-8", "ISO-8859-1", "Windows-1252",
498   - etc...
499   -
500   - 'before_send_file' is a function which is executed just before the HTTP server sends a
501   - file. It gets an action name and the web arguments received with the request for that
502   - file. Notice that this action name and these web arguments may be put into a
503   - 'private_download' element, and will come back to the server at the time of the
504   - download.
505   -
506   -
507   -
508   - ** (2.2) Directories on the server's disk.
509   -
510   - The description of you site contains the name of the directory within which the
511   - required files are located. This may be for example:
512   -
513   - my_anubis/web_sites/www.our-business.com/
514   -
515   - This is called the 'site directory' (for the given site). Within the site directory,
516   - the following directories are created by this program:
517   -
518   - states
519   - public
520   - journal
521   - private_download
522   - upload_temporary
523   -
524   - The directory 'states' is used for storing states (session informations). Out of date
525   - states are automatically removed after some time.
526   -
527   - The tree rooted at 'public' contains files that the server is allowed to send to the
528   - clients. For security reasons, the server never sends a file which is not within the
529   - tree whose root is this 'public' directory (except for the 'private download' mecanism;
530   - see 'web/multihost_http_server.anubis'). Also, the MIME type (see 'web/mime.anubis')
531   - must have been recognized before the file may be sent.
532   -
533   - The directory 'journal' contains the jounal files. The roles of the remaining
534   - directories 'private_download' and 'upload_temporary' is explained in
535   - 'multihost_http_server.anubis', where you will also find further informations on
536   - 'public' and 'journal'.
537   -
538   -
539   -
540   -
541   - ** (2.3) Web servers parameters.
542   -
543   - The web servers have several parameters useful for administration. They are described
544   - as follows:
545   -
546   - public type WebServersParameters:
547   - wsparms(Var(Bool) shutdown_required,
548   -
549   -
550   -
551   -
552   - ** (2.4) Starting your web sites.
553   -
554   - When you have described all your web sites (you may want to have several web sites, and
555   - they are distinguished by their 'common name'), you may start them all together using
556   - 'start_web_sites' below. This function returns a result of the following type:
557   -
558   -public type Start_Web_Sites_Result:
559   - cannot_bind_to_port(Int32),
560   - cannot_bind_to_port(Int32,Int32),
561   - ok(Server http_server,
562   - Server https_server).
563   -
564   - Indeed, it may happen that the system cannot bind (begin to listen) to one of the two
565   - ports (or to both). The main reason is that another server is already listening on that
566   - port. Another reason may be that 'anbexec' has not been correctly installed, i.e. that
567   - the 's' bit has not been set for 'user' and 'group' (there is not such problem under
568   - Windows). Also notice that the Linux kernel may need a rather long time (up to several
569   - minutes) before liberating a listening port. Now, if the system can bind to the two
570   - ports, the pair of the two servers is returned. Two tools are useful for manipulating
571   - servers:
572   -
573   - shutdown of type Server -> One
574   - is_down of type Server -> Bool
575   -
576   - They are defined in 'predefined.anubis' (together with the type 'Server').
577   -
578   -
579   -public define Start_Web_Sites_Result
580   - start_web_sites
581   - (
582   - Int32 ip_address, // the IP address shared by the web sites
583   - Int32 http_port, // usually: 80
584   - Int32 https_port, // usually: 443
585   - String ssl_certificate_common_name,
586   - List(Web_Site) web_sites, // web sites to be started
587   - Var(Bool) shutdown_required
588   - ).
589   -
590   - 'ip_address' is the IP address on which the two servers listen. If you put 0, the
591   - servers listen on all the IP addresses of the machine. This may be useful if the
592   - machine has several network interfaces.
593   -
594   - 'ssl_certificate_common_name' is the common name of the SSL certificate that 'anbexec'
595   - loads when it starts. One instance of 'anbexec' cannot handle more than one SSL server
596   - certificate. This is due to a problem of conception of SSL itself. See the book 'SSL
597   - and TLS' by Eric Rescorla (at Addison Wesley) for more explanations.
598   -
599   - Notice that the number of servers is always 2, regardless of the number of web sites
600   - you are starting.
601   -
602   - The dynamic variable 'shutdown_required' may be used to control the shutdown of the two
603   - servers from within the web site (typically the administration part). The servers will
604   - shutdown as soon as this variable contains 'true'. So you must provide a variable
605   - containing 'false' otherwise your servers will not run. You may also use the primitive
606   - 'must_restart' (see 'predefined.anubis') to control the restarting of your servers.
607   -
608   -
609   -
610   -
611   -
612   -
613   - * (3) The HTML interface.
614   -
615   - We propose an interface to dynamic HTML. Dynamic HTML includes HTML, and a combination
616   - of CSS (Cascading Style Sheet) and JavaScript techniques for making HTML elements more
617   - reactive and attractive on the client side.
618   -
619   -
620   - ** (3.1) Types used by the HTML interface.
621   -
622   - For easy reference, we gather below the definitions of all the types used by the HTML
623   - interface, and we comment them immediately.
624   -
625   -
626   -public type HTML_Size:
627   - absolute(Int32), // in pixels
628   - percentage(Int32).
629   -
630   -
631   -public type Text_Option:
632   - size(Int32), // size of character font to use
633   - font(String), // name of character font to use (such as "helvetica",...)
634   - color(RGB), // color to be used for characters
635   - italic,
636   - oblique,
637   - small_capitals,
638   - bold,
639   - underlined,
640   - left_justified,
641   - right_justified,
642   - justified, // justified on both sides
643   - line_through,
644   - nowrap,
645   - class(String). //CSS class
646   -
647   - A list of 'Text_Option' must be given with each text you want to put in your page.
648   -
649   - This indicate the way of reading text.
650   -public type Reading_Way:
651   - ltr, //the text is readable from "Left To Right" like english
652   - rtl. //the text is readable from "Right To Left" like arabic
653   -
654   -
655   -
656   -public type CoreAttrs:
657   - id (String),
658   - class (String),
659   - style (String),
660   - title (String).
661   -
662   -public type I18n:
663   - lang (String),
664   - dir (Reading_Way).
665   -
666   -public type DIV_Option:
667   - id (String),
668   - class (String),
669   - style (String),
670   - title (String),
671   - lang (String),
672   - dir (Reading_Way).
673   -
674   -
675   - A list of 'DIV_Option' must be given with each DIV you want to put in your page.
676   -
677   -
678   -public type Table_Option:
679   - background_color(RGB), // applied to all cells in the table
680   - background_image(String url),
681   - border(Int32 width_of_outer_edge, // if not present, all values are 0
682   - Int32 width_of_top_of_relief,
683   - Int32 width_of_inner_edge,
684   - RGB border_color),
685   - width(Int32), // sets a minimal width for the table
686   - percentage_width(Int32).
687   -
688   -
689   -public define Table_Option nude = border(0,0,0,rgb(0,0,0)).
690   -
691   -
692   - A list of 'Table_Option' must be given with each table.
693   -
694   -
695   -public type BackgroundOption:
696   - repeat, // repeat the background in both directions
697   - repeat_horizontal, // repeat the background only horizontally
698   - repeat_vertical, // repeat the background only verticall
699   - no_repeat, // don't repeat the background
700   - center.
701   -
702   -
703   -public type Cell_Option:
704   - left, // put the content of the cell on the left
705   - h_center, // center the content of the cell horizontally
706   - right, // put the content of the cell on the right
707   - top, // put the content of the cell upwards
708   - v_center, // center the content of tye cell vertically,
709   - bottom, // put the content of the cell downwards
710   - base_line, // align the content vertically according to base lines
711   - background_color(RGB),
712   - background_image(String url, BackgroundOption),
713   - width(Int32), // sets a minimal width for the cell
714   - percentage_width(Int32),
715   - height(Int32), // sets a minimal height for the cell
716   - columns(Int32), // lets the cell span over several columns
717   - rows(Int32), // lets the cell span over several rows
718   - nowrap. // do not allow text wrapping within the cell
719   -
720   - A list of 'Cell_Option' must be given with each cell and each row in a table. Options
721   - given with a row apply to all the cells in the row, but are superseded by options given
722   - with cells, which apply only to the cell they are given with.
723   -
724   -
725   -public type HTML_Cell($T):
726   - cell(List(Cell_Option) options, $T content).
727   -
728   - The parameter $T is later instantiated either to 'HTML_In_Form' or to 'HTML_Off_Form',
729   - depending on where you put your table (within a form or not within a form). For your
730   - convenience, we define the following particular case:
731   -
732   -public define HTML_Cell($T)
733   - cell
734   - (
735   - $T content
736   - ) =
737   - cell([],content).
738   -
739   -
740   -
741   -public type HTML_Row($T):
742   - row(List(Cell_Option) options, List(HTML_Cell($T)) cells).
743   -
744   - Same remark as for 'HTML_Cell($T)'. We define several convenience functions:
745   -
746   -public define HTML_Row($T)
747   - row
748   - (
749   - List(HTML_Cell($T)) cells
750   - ) =
751   - row([],cells).
752   -
753   -public define HTML_Row($T)
754   - row
755   - (
756   - HTML_Cell($T) cell
757   - ) =
758   - row([],[cell]).
759   -
760   -public type Actioner_Connection:
761   - same, // use same type of connection as current page
762   - http, // use non secured connection
763   - https. // use secured connection
764   -
765   -public type Other_Window_Option:
766   - resizable, // the new window may be resized by the client
767   - scrollbars, // the new window has scrollbars
768   - width(Int32), // the new window has the specified width
769   - height(Int32). // the new window has the specified height
770   -
771   -public type Actioner_Target:
772   - same,
773   - same (String label),
774   - other(String window_name, List(Other_Window_Option)).
775   -
776   -public type Actioner_Aspect:
777   - link (List(Text_Option),String text), // hypertext link
778   - push_button (List(CoreAttrs),String text),
779   - button (String url_off, String url_on), // rollover button
780   - button (String url_off, String url_on, Int32 w, Int32 h), // idem with size
781   - immediate_selector (String name, Int32 size, List(String) choices).
782   -
783   -
784   -public type Actioner_Local_Action:
785   - close_window.
786   -
787   -
788   -public define Actioner_Aspect
789   - link
790   - (
791   - String text
792   - ) =
793   - link([],text).
794   -
795   -
796   -public define Actioner_Aspect
797   - link
798   - (
799   - List(Text_Option) options,
800   - Int32 i
801   - ) =
802   - link(options,integer_to_string(i)).
803   -
804   -public define Actioner_Aspect
805   - link
806   - (
807   - Int32 i
808   - ) =
809   - link([],i).
810   -
811   -public define Actioner_Aspect
812   - button
813   - (
814   - String url_img
815   - ) =
816   - button(url_img,url_img).
817   -
818   -
819   -
820   - Actioners are explained in details below.
821   -
822   -
823   -public type TextAreaOption:
824   - disabled,
825   - read_only,
826   - wrap_lines.
827   -
828   -public type HTML_In_Form:
829   - literal_pt (Printable_tree),
830   - literal (String),
831   - sequence (List(HTML_In_Form) items),
832   - text (List(Text_Option), String the_text),
833   - preformated (List(Text_Option), String),
834   - paragraph (List(Text_Option), String the_text),
835   - image (String url),
836   - image (String url, Int32 width, Int32 height),
837   - table (List(Table_Option), List(HTML_Row(HTML_In_Form))),
838   - center (HTML_In_Form),
839   - mail_to (String email, HTML_In_Form element),
840   - scroller (Int32 width, Int32 height,
841   - Int32 content_width, Int32 content_height,
842   - HTML_In_Form content),
843   - actioner (Actioner_Connection, Actioner_Target, Actioner_Aspect,
844   - String action_name, List((String,String)) extra_ops,
845   - List(Actioner_Local_Action)),
846   - foreign_link (List(Text_Option), String url, String name),
847   - private_download (String abs_path, String name, String extra_ext,
848   - Maybe((String,List((String,String)))) action),
849   - text_input (String label_text, String label, String name, String init, Int32 width),
850   - password_input (String label_text, String label, String name, Int32 width),
851   - text_area (List(TextAreaOption), String name, String init, Int32 width, Int32 height),
852   - file_upload (String name, Int32 width),
853   - selector (String name, Int32 size, List(String) choices),
854   - selector (String name, Int32 size, List(String) choices, String selected),
855   - // List((String,String)) = List((code,name)) where :
856   - // name appears in selector
857   - // code is the web-arg value
858   - selector_c (String name, Int32 size, List((String,String)) choices),
859   - selector_c (String name, Int32 size, List((String,String)) choices, String selected),
860   - radio_button (String label_text, String label, String name, String value, Bool checked),
861   - check_box (String label_text, String label, String name, Bool checked),
862   - div (List(DIV_Option), HTML_In_Form content),
863   - div_empty (List(DIV_Option)),
864   - hidden (String name, String value).
865   -
866   -
867   - 'HTML_In_Form' defines all the elements you may put within a form. We define a
868   - convenience function:
869   -
870   -public define HTML_In_Form literal(Printable_tree t) = literal_pt(t).
871   -
872   -public define HTML_In_Form
873   - foreign_link
874   - (
875   - Int32 tsize,
876   - String url,
877   - String name
878   - ) =
879   - foreign_link([size(tsize)],url,name).
880   -
881   -public define HTML_In_Form
882   - actioner
883   - (
884   - Actioner_Connection conn,
885   - Actioner_Target targ,
886   - Actioner_Aspect asp,
887   - String action_name,
888   - List((String,String)) extra_ops
889   - ) =
890   - actioner(conn,targ,asp,action_name,extra_ops,[]).
891   -
892   -
893   -
894   -public define HTML_In_Form
895   - text_area
896   - (
897   - String name,
898   - String init,
899   - Int32 width,
900   - Int32 height
901   - ) =
902   - text_area([],name,init,width,height).
903   -
904   -public define HTML_In_Form
905   - table
906   - (
907   - List(HTML_Row(HTML_In_Form)) rows
908   - ) =
909   - table([],rows).
910   -
911   -
912   -public define HTML_In_Form
913   - private_download
914   - (
915   - String abs_path,
916   - String name,
917   - String extra_ext
918   - ) =
919   - private_download(abs_path,name,extra_ext,failure).
920   -
921   -public define HTML_In_Form
922   - private_download
923   - (
924   - String abs_path,
925   - String name,
926   - String extra_ext,
927   - String action_name,
928   - List((String,String)) args
929   - ) =
930   - private_download(abs_path,name,extra_ext,success((action_name,args))).
931   -
932   -public define HTML_In_Form
933   - text
934   - (
935   - String s
936   - ) =
937   - text([],s).
938   -
939   -
940   -
941   -
942   -public type HTML_Off_Form:
943   - literal_pt (Printable_tree),
944   - literal (String),
945   - sequence (List(HTML_Off_Form) items),
946   - text (List(Text_Option), String the_text),
947   - preformated (List(Text_Option), String),
948   - paragraph (List(Text_Option), String the_text),
949   - image (String url),
950   - image (String url, Int32 width, Int32 height),
951   - table (List(Table_Option), List(HTML_Row(HTML_Off_Form))),
952   - center (HTML_Off_Form),
953   - mail_to (String email, HTML_Off_Form element),
954   - scroller (Int32 width, Int32 height,
955   - Int32 content_width, Int32 content_height,
956   - HTML_Off_Form content),
957   - fixed_size (HTML_Size width, HTML_Size height, HTML_Off_Form content),
958   - fixed_size_2 (HTML_Size width, HTML_Size height, String name_of_HTML_file),
959   - actioner (Actioner_Connection, Actioner_Target, Actioner_Aspect,
960   - String action_name, List((String,String)) extra_ops,
961   - List(Actioner_Local_Action)),
962   - actioner (Actioner_Connection, Actioner_Target, Actioner_Aspect,
963   - String action_name, List((String,String)) extra_ops,
964   - List(Actioner_Local_Action), String form_name),
965   - foreign_link (List(Text_Option), String url, String name),
966   - private_download (String abs_path, String name, String extra_ext,
967   - Maybe((String,List((String,String)))) action),
968   - label (String name),
969   - form (String form_name, List(CoreAttrs), HTML_In_Form content),
970   - div (List(DIV_Option), HTML_Off_Form content),
971   - div_empty (List(DIV_Option)).
972   -
973   - 'HTML_Off_Form' defines all the elements you may put outside any form.
974   -
975   -
976   -public define HTML_Off_Form literal(Printable_tree t) = literal_pt(t).
977   -public define HTML_Off_Form fixed_size(HTML_Size width, HTML_Size height, String name_of_HTML_file)
978   - = fixed_size_2(width,height,name_of_HTML_file).
979   -
980   -
981   -public define HTML_Off_Form
982   - foreign_link
983   - (
984   - Int32 tsize,
985   - String url,
986   - String name
987   - ) =
988   - foreign_link([size(tsize)],url,name).
989   -
990   -
991   -public define HTML_Off_Form
992   - actioner
993   - (
994   - Actioner_Connection conn,
995   - Actioner_Target targ,
996   - Actioner_Aspect asp,
997   - String action_name,
998   - List((String,String)) extra_ops
999   - ) =
1000   - actioner(conn,targ,asp,action_name,extra_ops,[]).
1001   -
1002   -public define HTML_Off_Form
1003   - table
1004   - (
1005   - List(HTML_Row(HTML_Off_Form)) rows
1006   - ) =
1007   - table([],rows).
1008   -
1009   -
1010   -
1011   - We add two convenience functions for 'row'. The reason why we add two functions, one
1012   - for 'HTML_In_Form' and one for 'HTML_Off_Form', is that adding a schema with an
1013   - arbitrary '$T' creates too many ambiguities. This is due to the fact that, if we do so,
1014   - the arguments of the function do not refer to any of the types defined here.
1015   -
1016   -public define HTML_Row(HTML_In_Form)
1017   - row
1018   - (
1019   - HTML_In_Form content
1020   - ) =
1021   - row([],[cell([],content)]).
1022   -
1023   -public define HTML_Row(HTML_Off_Form)
1024   - row
1025   - (
1026   - HTML_Off_Form content
1027   - ) =
1028   - row([],[cell([],content)]).
1029   -
1030   -
1031   -public define HTML_Off_Form
1032   - private_download
1033   - (
1034   - String abs_path,
1035   - String name,
1036   - String extra_ext
1037   - ) =
1038   - private_download(abs_path,name,extra_ext,failure).
1039   -
1040   -
1041   -public define HTML_Off_Form
1042   - private_download
1043   - (
1044   - String abs_path,
1045   - String name,
1046   - String extra_ext,
1047   - String action_name,
1048   - List((String,String)) args
1049   - ) =
1050   - private_download(abs_path,name,extra_ext,success((action_name,args))).
1051   -
1052   -public define HTML_Off_Form
1053   - text
1054   - (
1055   - List(Text_Option) lto,
1056   - Int32 i
1057   - ) =
1058   - text(lto,integer_to_string(i)).
1059   -
1060   -
1061   -public define HTML_Off_Form
1062   - text
1063   - (
1064   - Int32 i
1065   - ) =
1066   - text([],i).
1067   -
1068   -public define HTML_Off_Form
1069   - text
1070   - (
1071   - String s
1072   - ) =
1073   - text([],s).
1074   -
1075   - - Cell a gap between two other cells :
1076   -
1077   -public define HTML_Cell(HTML_Off_Form)
1078   - width_gap
1079   - (
1080   - Int32 w
1081   - ) =
1082   - cell([width(w)],text([],"")).
1083   -
1084   -public define HTML_Cell(HTML_In_Form)
1085   - width_gap
1086   - (
1087   - Int32 w
1088   - ) =
1089   - cell([width(w)],text([],"")).
1090   -
1091   -
1092   - - Row a gap between two other rows :
1093   -
1094   -public define HTML_Row(HTML_Off_Form)
1095   - height_gap
1096   - (
1097   - Int32 h
1098   - ) =
1099   - row([],[cell([height(h)],text([],""))]).
1100   -
1101   -public define HTML_Row(HTML_In_Form)
1102   - height_gap
1103   - (
1104   - Int32 h
1105   - ) =
1106   - row([],[cell([height(h)],text([],""))]).
1107   -
1108   -
1109   - Notice that the two types have alternatives in common (same name, same arguments types,
1110   - up to the value of the parameter $T), which correspond to elements which may be put
1111   - anywhere in the page.
1112   -
1113   -
1114   -
1115   -public type CSS_Style:
1116   - text_options(List(Text_Option)).
1117   -
1118   -public type CSS_File:
1119   - css_file(String file_name).
1120   -
1121   -define String
1122   - format
1123   - (
1124   - List(Text_Option) l
1125   - ).
1126   -
1127   -
1128   -
1129   -
1130   -define Printable_tree
1131   - format_css_styles
1132   - (
1133   - List(CSS_Style) l
1134   - ) =
1135   - if l is
1136   - {
1137   - [ ] then [ ],
1138   - [h . t] then
1139   - [ if h is
1140   - {
1141   - text_options(tos) then
1142   - [" body, span, p { ", format(tos), " }\n" ]
1143   - }
1144   - . format_css_styles(t)]
1145   - }.
1146   -
1147   -
1148   -
1149   -public type HTML_Meta:
1150   - keywords (List(String)),
1151   - refresh (Actioner_Connection connection,
1152   - Actioner_Target target,
1153   - String action_name,
1154   - Int32 delay), // in seconds
1155   - meta (String name, String content),
1156   - http_equiv (String name, String content),
1157   - generic_meta (List((String,String))),
1158   - literal (String).
1159   -
1160   - Meta tags are put in the 'head' of the HTML page.
1161   -
1162   -
1163   -public type Body_Option:
1164   - background_color (RGB),
1165   - background_image (String url),
1166   - background_image (String url, List(BackgroundOption)).
1167   -
1168   -public type HTML_Body:
1169   - body(List(Body_Option) options, HTML_Off_Form content).
1170   -
1171   -
1172   -public type HTML_Page:
1173   - html_page(String title,
1174   - List(HTML_Meta) meta_tags,
1175   - List(CSS_Style) styles,
1176   - List(CSS_File) css_files,
1177   - HTML_Body body).
1178   -
1179   -public define HTML_Page
1180   - html_page
1181   - (
1182   - String title,
1183   - List(HTML_Meta) metas,
1184   - HTML_Body body
1185   - ) =
1186   - html_page(title,metas,[],[],body).
1187   -
1188   -public define HTML_Page
1189   - html_page
1190   - (
1191   - String title,
1192   - List(HTML_Meta) metas,
1193   - List(CSS_Style) styles,
1194   - HTML_Body body
1195   - ) =
1196   - html_page(title, metas, styles, [], body).
1197   -
1198   - 'HTML_Page' represents the final product of the construction of a web page.
1199   -
1200   -
1201   -
1202   -
1203   - *** (3.2) ``in form'' versus ``off form''.
1204   -
1205   - There is a variety of HTML elements: texts, buttons, links, forms, inputs, etc... Some
1206   - of them may have a content, which is yet another HTML element (or several). Hence, it
1207   - is meaningful to say that an element is 'within' another one. Now, putting any element
1208   - within any other one may be meaningless. For example, an input element must be put
1209   - within a form (otherwise, it is useless), and a from within another form has no precise
1210   - meaning (and is forbidden by the HTML specification).
1211   -
1212   - Actually, the main criterium is ``within a form or not within a form''. So, HTML
1213   - elements in a given page are separated into two categories: those who are within a
1214   - form, and the others. Nevertheless, there are elements which may belong to both
1215   - categories, like images and texts. We want to make use of the strong typing mecanism of
1216   - Anubis in order to forbid non meaningful placement of elements.
1217   -
1218   - The type 'HTML_In_Form' defines elements to be put within forms. Similarly,
1219   - 'HTML_Off_Form' defines elements not to be put within forms. Both types are recursive,
1220   - and 'HTML_Off_Form' refers to 'HTML_In_Form' (via the 'form' alternative, of course),
1221   - but the two types are not cross recursive. This is the reason why it is impossible to
1222   - put a form within a form. In order to construct a web page, you essentially have to
1223   - produce a datum of type 'HTML_Off_Form' (maybe containing data of type 'HTML_In_Form').
1224   -
1225   - In practice, you don't have to worry so much about these two types, because elements
1226   - which may be put anywhere are constructed for both types by functions with the same
1227   - name and the same arguments. Hence, for both types, you just write the same thing. You
1228   - are warned by the compiler only when you try to put an element at a place it is not
1229   - allowed.
1230   -
1231   -
1232   -
1233   - *** (3.3) Defining your own style.
1234   -
1235   - We provide generic tools for constructing HTML elements. However, your web site needs
1236   - to have a ``style''.
1237   -
1238   - To that end, you need to write down a set of ``styling functions'', using the tools
1239   - defined here. These styling functions allow the introduction of your colors and other
1240   - visual characteristics into the constructed elements once and for all. For example, you
1241   - may want all your texts to be rendered in the ``Helvetica'' font, in size 14 and using
1242   - some 'text_color'. You may write something like this:
1243   -
1244   - define RGB text_color = rgb(10,40,40).
1245   -
1246   - define HTML_Off_Form
1247   - text
1248   - (
1249   - String the_text
1250   - ) =
1251   - text([font("helvetica"),size(14),color(text_color)],
1252   - the_text).
1253   -
1254   - (and the same one for type 'HTML_In_Form') so that in order to put a piece of text in a
1255   - page, you just write:
1256   -
1257   - text("... some text ...")
1258   -
1259   - and you don't have to provide the font, size and color for each text. If you want to
1260   - have several styles of text presentation, you just write several sets of such
1261   - convenience functions. This also suggests a trick. You may want for example different
1262   - colors for 'in form' texts and 'off form' texts. This may be achieved automatically by
1263   - defining two functions as above, with the same name and same argument type, but
1264   - returning either a 'HTML_In_Form' or a 'HTML_Off_Form'.
1265   -
1266   - If this preliminary work is well done, you will not waste your time later when you
1267   - concentrate on the actual informational content of your pages.
1268   -
1269   - This general principle should be applied to all sorts of elements. This is the best
1270   - thing to do in order to separate the functions defining the visual style from the
1271   - functions defining the informational content itself, so that changing the style without
1272   - changing the content becomes easy. This is also the best way for having a clean and
1273   - easily readable source for your web site.
1274   -
1275   -
1276   -
1277   -
1278   -
1279   - *** (3.4) Actioners and forms.
1280   -
1281   - We have gathered several notions from HTML into that of an 'actioner'. An actioner is
1282   - an HTML element which opens a connection to our server when clicked upon. Actioners may
1283   - have different visual aspects. They may look like hypertext links or like buttons
1284   - (rollovers), or even like selectors (with immediate action). In any case, their
1285   - behavior is the same: they open a connection to our server, and send a set of 'web
1286   - arguments', i.e. pairs 'name=value'. Among these web arguments, one of them denotes
1287   - the action to be performed, and the others should be considered as operands for this
1288   - action. Actually, the precise behavior of the actioner has several variants.
1289   -
1290   - The connection with the server may be secured (HTTPS) or non secured (HTTP). See the
1291   - type 'Actioner_Connection' above.
1292   -
1293   - You must also choose where the answer must be rendered. This may be in the same window
1294   - or in another window (or frame). If it is in another window, the name of that window
1295   - must be given. If the window does not exist, the browser will create it. Optionally,
1296   - you may give the dimensions of the new window and other characteristics. See the type
1297   - 'Actioner_Target' above.
1298   -
1299   - The actioner also has a visual aspect. See the type 'Actioner_Aspect' above. In the
1300   - case of a rollover button, you provide the URLs of two images (of the same size)
1301   - representing the button:
1302   -
1303   - url_off: to be used when the mouse is not over the button,
1304   - url_on: to be used when the mouse is over the button.
1305   -
1306   - You can also create rollover buttons without creating images. Just use the second
1307   - alternative named 'button'. The server creates the images automatically.
1308   -
1309   - The purpose of forms is just to give operands to actioners. If the actioner is placed
1310   - within a form, all the input elements which are within this form provide operands to
1311   - the actioner (except sometimes when they are not set by the client). If it is not put
1312   - within a form, the actioner gets no operand, except if the name of a form is explicitly
1313   - given, in which case the actioner gets all the inputs from that form as
1314   - operands. Furthermore, you may want to give extra operands to the actioner. This may be
1315   - useful for separating families of actioners with the same action name. Extra operands
1316   - 'name=value' must be given in the form of pairs '(name,value)'.
1317   -
1318   - Notice that the name of a form may be used by an actioner which is off the form, so as
1319   - to get the operands provided by this form. Also notice that several actioners may refer
1320   - to the same form, being either in the form, or referring to the form from the
1321   - outside. These actioners simply get the same set of operands, even if they correspond
1322   - to distinct actions.
1323   -
1324   - Input elements may be put only within a form.
1325   -
1326   -
1327   -
1328   - *** (3.5) Local popup.
1329   -
1330   - This element looks like a link or a rollover button. When this button is clicked upon,
1331   - a 'popup window' appears. Actually, this popup window is just a layer in the same HTML
1332   - page, which becomes suddenly visible. It is realized with a '<div>' HTML tag. In
1333   - particular, clicking on the button does not open any connection. This is why it is
1334   - called 'local'. The arguments have the following roles:
1335   -
1336   - Actioner_Aspect aspect of the button (same semantics as for actioners)
1337   - content content of the popup window
1338   - x, y, position of the popup window on the HTML page (not relative
1339   - to the button but to the page itself)
1340   - title title of the popup window
1341   - color color of the title bar and close button in the popup window.
1342   - A lightened version of this color is used for the background
1343   - of the popup window.
1344   - width width of the title bar
1345   -
1346   -
1347   -
1348   -
1349   -
1350   - --- That's all for the public part ! --------------------------------------------------
1351   -
1352   -
1353   -
1354   -
1355   -
1356   - ----------------------------------- Table of Contents ---------------------------------
1357   -
1358   - *** [1] States.
1359   - *** [1.1] Saving and retrieving states.
1360   - *** [1.2] Deleting out of date states.
1361   -
1362   - *** [2] Tools.
1363   - *** [2.1] Directories.
1364   - *** [2.2] Secondary documents.
1365   -
1366   - *** [3] Managing web arguments.
1367   - *** [3.1] Prefixing web arguments names.
1368   - *** [3.2] Separating web arguments.
1369   - *** [3.3] Applying an action.
1370   -
1371   - *** [4] Web site descriptions and the 'awp handlers'.
1372   - *** [4.1] The type 'Web_Site'.
1373   - *** [4.2] Making a web site description.
1374   - *** [4.3] Starting the servers.
1375   -
1376   - *** [5] HTML Formating.
1377   - *** [5.1] The type 'HTML_Any($T)'.
1378   - *** [5.2] Formating a color.
1379   - *** [5.3] Creating buttons.
1380   - *** [5.4] Formating an actioner.
1381   - *** [5.5] Formating a private download link.
1382   - *** [5.6] Formating rows and cells in a table.
1383   - *** [5.7] Formating elements which may be put anywhere.
1384   - *** [5.8] Formating 'in form' elements.
1385   - *** [5.9] Formating 'off form' elements.
1386   - *** [5.10] Formating meta-tags.
1387   -
1388   - ---------------------------------------------------------------------------------------
1389   -
1390   -
1391   -
1392   -
1393   -public define String
1394   - doctype_w3c_header
1395   - =
1396   - "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" "+
1397   - "\"http://www.w3c.org/TR/html4/loose.dtd\">\n".
1398   -
1399   -
1400   -
1401   -
1402   - *** [1] States.
1403   -
1404   - We have to define functions for saving a state, retrieving a state, deleting out of
1405   - date states. We need one such function per web site. The types of the first two
1406   - functions depend on the parameter $State. This is not the case of the third one. The
1407   - fact that the instance of $State is variable from one web sites to the other implies
1408   - rather subtle manipulations using full functionality.
1409   -
1410   -
1411   - *** [1.1] Saving and retrieving states.
1412   -
1413   - Each state is saved into a file on the server's disk (in the directory represented by
1414   - the symbol 'state_directory', which is 'my_anubis/web_sites/common_name/states'). The
1415   - state is saved together with a time stamp whose value is obtained by adding the current
1416   - time to the given timeout for states. The state receives a name obtained by hashing
1417   - (using sha1) the content of the file itself, and then encoding the hash with
1418   - 'web_arg_encode'. The name of the file into which the state is saved is the
1419   - concatenation of "s" and the name of the state.
1420   -
1421   -read CXM_web_arg_encode.anubis
1422   -
1423   - The tool below constructs the function which is able to save a state on the server's
1424   - disk.
1425   -
1426   -define (Maybe($State) s) -> String // the function constructed returns the name of the state
1427   - make_save_state_function
1428   - (
1429   - Int32 timeout,
1430   - String state_directory
1431   - ) =
1432   - (Maybe($State) mbs) |->
1433   - if mbs is
1434   - {
1435   - failure then "",
1436   - success(s) then
1437   - with time_stamp = now+timeout,
1438   - to_be_saved = (time_stamp,s),
1439   - state_name = web_arg_encode(sha1(s)),
1440   - if save(to_be_saved,state_directory+"/s"+state_name) is ok
1441   - then state_name
1442   - else (print("Cannot create state file in '"+state_directory+"'.\n"); "")
1443   - }.
1444   -
1445   -
1446   - When a request arrives, we need to retrieve the previous state from the server's
1447   - disk. We receive the name of that state. If the state is out of date, the state file is
1448   - kept 3 days, and then deleted.
1449   -
1450   -type PreviousState($State):
1451   - not_found, // cannot retrieve the previous state
1452   - out_of_date($State), // the previous state is out of date
1453   - still_valid($State). // the previous state is still valid
1454   -
1455   -define (String state_name) -> PreviousState($State)
1456   - make_retrieve_state_function
1457   - (
1458   - String state_directory
1459   - ) =
1460   - (String state_name) |->
1461   - with file_path = state_directory+"/s"+state_name,
1462   - if (RetrieveResult((Int32,$State)))retrieve(file_path) is ok(d)
1463   - then (
1464   - if d is (time_stamp,s) then
1465   - if time_stamp < now
1466   - then (
1467   - forget(remove(file_path));
1468   - out_of_date(s)
1469   - )
1470   - else still_valid(s) // state has been successfully retrieved
1471   - )
1472   - else not_found.
1473   -
1474   -
1475   -
1476   - *** [1.2] Deleting out of date states.
1477   -
1478   - We also need to delete states which are out of date and which will never be deleted by
1479   - the above method. This may be performed by a machine doing this periodically (say once
1480   - per states life time period).
1481   -
1482   -define (List(String) file_names) -> One
1483   - make_delete_out_of_date_states_function
1484   - (
1485   - Maybe($State) dummy,
1486   - String state_directory
1487   - ) =
1488   - (List(String) file_names) |-df->
1489   - if file_names is
1490   - {
1491   - [ ] then unique,
1492   - [h . t] then
1493   - with file_path = state_directory+"/"+h,
1494   - if (RetrieveResult((Int32,$State)))retrieve(file_path) is ok(d)
1495   - then (
1496   - if d is (time_stamp,data) then
1497   - if time_stamp < now
1498   - then (forget(remove(file_path)); df(t))
1499   - else df(t)
1500   - )
1501   - else (forget(remove(file_path)); df(t))
1502   - }.
1503   -
1504   -
1505   - The 'labelled arrow' |-df-> is documented in 'documentation/en/anubis_doc.txt'.
1506   -
1507   - Note: The argument 'dummy' (of type Maybe($State)) is not used in the body of the
1508   - function (hence its name). Nevertheless, it is required. Indeed, the Anubis compiler
1509   - does not accept a parameter in the body of a function (here the parameter is required
1510   - by the use of 'retrieve') if this parameter does not appear in the type of the
1511   - function. This is because this would create ambiguities that no explicit typing may
1512   - ever resolve. If you put a double slash in front of the declaration of 'dummy' above,
1513   - and if you compile this file, you will get a message like this one:
1514   -
1515   - Error in 'making_a_web_site.anubis', line 1300, column 7:
1516   - A definition may not contain parameters which are not present
1517   - in the declaration part (hidden parameters):
1518   - $State
1519   -
1520   - The type of the function constructed by 'make_delete_out_of_date_states_function' is
1521   - independant of the parameter $State. This is important because this allows to create
1522   - the list of such functions for all web sites. From this list, it is possible to call
1523   - the functions one after the other, so deleting out of date states for all web
1524   - sites. Actually, the next function receives a list of pairs (state_directory,function),
1525   - one for each web site.
1526   -
1527   -define One
1528   - delete_out_of_date_states // for all web sites
1529   - (
1530   - List((String, List(String) -> One)) directories_and_functions
1531   - ) =
1532   - if directories_and_functions is
1533   - {
1534   - [ ] then unique,
1535   - [h . t] then if h is (state_directory,function) then
1536   - function(directory_list(state_directory,"s*"));
1537   - delete_out_of_date_states(t)
1538   - }.
1539   -
1540   -
1541   - The above function must be called periodically in a separate virtual machine. The
1542   - period we have choosen is (rather logically) the life time of states itself. This may
1543   - be achieved by an 'infinite' loop, using a 'sleep(timeout)'. However, the loop must not
1544   - be really infinite, because the servers may be shutdown. Hence, our loop must test
1545   - (rather frequently; say every second) if the servers are down. If they are, the loop
1546   - must be exited.
1547   -
1548   -define One
1549   - delete_states_loop
1550   - (
1551   - List((String,List(String) -> One)) directories_and_functions,
1552   - Int32 timeout,
1553   - Int32 next_time,
1554   - Server http_server,
1555   - Server https_server,
1556   - Var(Bool) shutdown_required
1557   - ) =
1558   - if *shutdown_required
1559   - then (shutdown(http_server); shutdown(https_server))
1560   - else unique;
1561   - if (is_down(http_server) & is_down(https_server))
1562   - then unique
1563   - else if now > next_time
1564   - then
1565   - (
1566   - delete_out_of_date_states(directories_and_functions);
1567   - delete_states_loop(directories_and_functions,
1568   - timeout,
1569   - now+timeout,
1570   - http_server,
1571   - https_server,
1572   - shutdown_required)
1573   - )
1574   - else
1575   - (
1576   - sleep(1000); // sleep just one second and try again
1577   - delete_states_loop(directories_and_functions,
1578   - timeout,
1579   - next_time,
1580   - http_server,
1581   - https_server,
1582   - shutdown_required)
1583   - ).
1584   -
1585   - The above loop must be run in a separate virtual machine. This will be done just after
1586   - the two servers are started.
1587   -
1588   -
1589   -
1590   -
1591   -
1592   - *** [2] Tools.
1593   -
1594   - *** [2.1] Directories.
1595   -
1596   - We need a tool for creating directories (if needed).
1597   -
1598   - (This tool has been moved to 'tools/basis.anubis').
1599   -
1600   -
1601   -
1602   -
1603   - *** [2.2] Secondary documents.
1604   -
1605   - Some HTML elements (like '<object>', '<frame>') cannot receive their content directly
1606   - from the current document, but only through an URL. For this reason, we implement a
1607   - mecanism for creating secondary documents on the fly. To that end we use the 'private
1608   - download' mecanism.
1609   -
1610   - A secondary document is formated by the same functions as the main document itself. The
1611   - next function takes an 'off form' element, creates the file containing the secondary
1612   - document in HTML format, and returns the URL at which the document will be available.
1613   -
1614   -define String
1615   - create_secondary_document
1616   - (
1617   - String sd, // site directory
1618   - String as, // authorization_secret
1619   - String sn, // state name
1620   - $T -> Printable_tree format_element,
1621   - $T content,
1622   - HTML_Size width
1623   - ) =
1624   - with private_download_directory = sd+"/private_download",
1625   - hash = web_arg_encode(sha1(content)),
1626   - file_content = (Printable_tree)
1627   - [doctype_w3c_header,
1628   - "<html><body><table ",
1629   - if width is
1630   - {
1631   - absolute(w) then ["width=\"",w-25],
1632   - percentage(w) then ["width=\"95%\""]
1633   - },"\"><tr><td align=right>",
1634   - format_element(content),
1635   - "</td></tr></table></body></html>"
1636   - ],
1637   - file_name = "sd"+hash+".html",
1638   - file_path = private_download_directory+"/"+file_name,
1639   - if write_to_file(file_path,file_content) is
1640   - {
1641   - cannot_open_file then print("Cannot open file '"+file_path+"'.\n"); "",
1642   - write_error(n) then print("Error writing file '"+file_path+"'.\n"); "",
1643   - ok then file_name+"?zauth="+
1644   - make_authorization(sd,as,private_download_directory+"/"+file_name)
1645   - }.
1646   -
1647   -
1648   -
1649   -
1650   - *** [2.3] Generating unique ids.
1651   -
1652   - In order to uniquely name object for JavaScript we generate unique ids from a counter.
1653   -
1654   -define Int32
1655   - new_idnum
1656   - (
1657   - Var(Int32) ic_v // 'idnum' counter variable
1658   - ) =
1659   - protect
1660   - with result = *ic_v+1,
1661   - ic_v <- result;
1662   - result.
1663   -
1664   -
1665   -
1666   -
1667   -
1668   -
1669   - *** [3] Managing web arguments.
1670   -
1671   - Web arguments are those pairs 'name=value' which are transmitted through the HTTP
1672   - protocol. We need precise naming conventions for these web arguments.
1673   -
1674   -
1675   -
1676   - *** [3.1] Prefixing web arguments names.
1677   -
1678   - We want to assign different roles to web arguments, and we also want to be able to
1679   - recognize its role directly from the name of a web argument. The name "s" is reserved
1680   - for the web argument whose value is the name of the current state. The name "a" is
1681   - reserved for the web argument whose value is the name of the action to be
1682   - performed. Other web arguments receive arbitrary names, and in order to avoid clashes,
1683   - these names are prefixed by:
1684   -
1685   - "p" for names of password inputs,
1686   - "o" for other web arguments
1687   -
1688   - The reason why password input names have a distinct prefix is that this allows the HTTP
1689   - server to hide the passwords on the console of the server and in the journal.
1690   -
1691   -
1692   -
1693   -
1694   - *** [3.2] Separating web arguments.
1695   -
1696   - When a new request arrives, we need to separate the web arguments, that is to say:
1697   -
1698   - - find the value of "s", and recover the corresponding state,
1699   - - find the value of "a", which is the name of the action to be performed,
1700   - - get the list of all the remaining web arguments (operands of the action).
1701   -
1702   - We must also determine if the previous state may be recovered. If it is not the case
1703   - (either because the previous state name is invalid, or the previous state is out of
1704   - date), we must check if there is an action name. Indeed, the presence of an action name
1705   - indicates that the user has clicked on one of our buttons or links. If on the contrary
1706   - there is no action name the user has just entered our address in his browser. In this
1707   - last case, we must send the first page of our site (maybe a 'login' page), but if there
1708   - is an action, we must send a page just saying that the session ticket has expired. If
1709   - the previous state is recovered and there is no action, the new state is the same as
1710   - the previous state.
1711   -
1712   - The result of the separation of the web arguments is of type:
1713   -
1714   -type Separated_Web_Args($State):
1715   - swa(Maybe(PreviousState($State)) previous_state,
1716   - Maybe(String) action_name,
1717   - List(Web_arg) operands).
1718   -
1719   -
1720   -
1721   - The next function constructs the function which separates the web arguments.
1722   -
1723   -define (List(Web_arg) lwa) -> Separated_Web_Args($State)
1724   - make_separate_web_args_function
1725   - (
1726   - String state_directory,
1727   - String -> PreviousState($State) retrieve_state
1728   - ) =
1729   - (List(Web_arg) lwa) |-swaf->
1730   - if lwa is
1731   - {
1732   - [ ] then
1733   - //
1734   - // no web arg found => no previous state and no action
1735   - //
1736   - swa(failure,failure,[]),
1737   -
1738   - [wa_1 . wa_others] then
1739   - //
1740   - // at least one web arg =>
1741   - // separate other web args, and insert the first one as needed
1742   - //
1743   - if (Separated_Web_Args($State))swaf(wa_others) is
1744   - {
1745   - swa(ps1, // possible previous state
1746   - an1, // maybe an action name
1747   - op1) // operands so far
1748   - then
1749   - if wa_1 is
1750   - {
1751   - web_arg(n,v) then
1752   - with prefix = if substr(n,0,4) = "amp;" then substr(n,4,1) else substr(n,0,1),
1753   - name_start = (Int32)(if substr(n,0,4) = "amp;" then 5 else 1),
1754   - if prefix = "s" then
1755   - swa(success(retrieve_state(v)),an1,op1) else
1756   - if prefix = "a" then
1757   - swa(ps1,success(v),op1) else
1758   - if prefix = "t" then
1759   - swa(ps1,an1,[web_arg("target",v) . op1]) else
1760   - if prefix = "p" then
1761   - swa(ps1,an1,[web_arg(substr(n,name_start,length(n)-name_start),v) . op1]) else
1762   - if prefix = "o" then
1763   - swa(ps1,an1,[web_arg(substr(n,name_start,length(n)-name_start),v) . op1]) else
1764   - swa(ps1,an1,op1),
1765   -
1766   - upload(n,v,t) then
1767   - swa(ps1,an1,[upload(substr(n,1,length(n)-1),v,t) . op1])
1768   - }}
1769   - }.
1770   -
1771   -
1772   -
1773   -
1774   -
1775   -
1776   - *** [3.3] Applying an action.
1777   -
1778   - When the web arguments are separated (and their names cleaned up from prefixes), we may
1779   - apply the action to the operands and the current state. We search for the action to be
1780   - applied in the list of actions. If no action is found, the new state is the same as
1781   - the previous state. Also, we deny the application of an HTTP action if the request
1782   - arrives through the HTTPS channel and conversely.
1783   -
1784   -
1785   -define (Maybe($State) previous,
1786   - String action_name,
1787   - HTTP_Info http_info,
1788   - List(Web_arg) lwa,
1789   - Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header))
1790   - make_apply_action_function
1791   - (
1792   - List(Web_Action($SessionTicket, $State)) actions
1793   - ) =
1794   - with f =
1795   - (Maybe($State) previous,
1796   - String action_name,
1797   - HTTP_Info http_info,
1798   - List(Web_arg) lwa,
1799   - Bool is_https,
1800   - List(Web_Action($SessionTicket, $State)) actions) |-f->
1801   - if actions is
1802   - {
1803   - [ ] then (print("action '"+action_name+
1804   - "' not found.\n"); (failure, previous, [])),
1805   - [ac1 . others] then if ac1 is
1806   - {
1807   - http_action(an,allow,do_it) then
1808   - if an = action_name
1809   - then if is_https
1810   - then (print("HTTP action '"+an+
1811   - "' called through HTTPS (denied).\n");
1812   - (failure, previous, []))
1813   - else if allow(previous)
1814   - then do_it(http_info,lwa,previous)
1815   - else (failure, previous, [])
1816   - else f(previous,action_name,http_info,lwa,is_https,others),
1817   -
1818   - https_action(an,allow,do_it) then
1819   - if an = action_name
1820   - then if is_https
1821   - then if allow(previous)
1822   - then do_it(http_info,lwa,previous)
1823   - else (failure, previous, [])
1824   - else (print("HTTPS action '"+an+
1825   - "' called through HTTP (denied).\n");
1826   - (failure, previous, []))
1827   - else f(previous,action_name,http_info,lwa,is_https,others),
1828   -
1829   - http_https_action(an,allow,do_it) then
1830   - if an = action_name
1831   - then if allow(previous)
1832   - then do_it(http_info,lwa,previous)
1833   - else (failure, previous, [])
1834   - else f(previous,action_name,http_info,lwa,is_https,others),
1835   -
1836   - }
1837   - },
1838   - (Maybe($State) previous,
1839   - String action_name,
1840   - HTTP_Info http_info,
1841   - List(Web_arg) lwa,
1842   - Bool is_https) |->
1843   - f(previous,action_name,http_info,lwa,is_https,actions).
1844   -
1845   -
1846   -
1847   -
1848   -
1849   -
1850   -
1851   -
1852   - *** [4] Web site descriptions and the 'awp handlers'.
1853   -
1854   - *** [4.1] The type 'Web_Site'.
1855   -
1856   - The type 'Web_Site_Description' is defined in 'web/multihost_http_server.anubis'. We
1857   - need another one, because, we have some extra informations to record for each site.
1858   -
1859   -public type Web_Site:
1860   - web_site((Int32,Int32) -> Web_Site_Description description,
1861   - List(String) -> One delete_out_of_date).
1862   -
1863   -
1864   -
1865   -
1866   - *** [4.2] Making a web site description.
1867   -
1868   - Below is the function which creates a web site description. It first creates (if
1869   - needed) the directories for the site, then constructs the tool functions for the site,
1870   - and the site handler. Finally, it constructs the web site description.
1871   -
1872   - We gather common (constant) informations in the following type:
1873   -
1874   -type CommonInfo:
1875   - info(String common_name,
1876   - Int32 http_port,
1877   - Int32 https_port,
1878   - String site_directory,
1879   - String authorization_secret
1880   - ).
1881   -
1882   - We need a forward declaration.
1883   -
1884   -public define Printable_tree
1885   - format
1886   - (
1887   - CommonInfo cinfo,
1888   - String state_name,
1889   - HTML_Page page,
1890   - Bool is_https,
1891   - String charset
1892   - ).
1893   -
1894   -
1895   -define Printable_tree
1896   - format
1897   - (
1898   - HTML_Size s
1899   - ) =
1900   - if s is
1901   - {
1902   - absolute(x) then ["\"",x,"\""],
1903   - percentage(x) then ["\"",x,"%\""]
1904   - }.
1905   -
1906   -define Printable_tree
1907   - top_redirection_page
1908   - (
1909   - String common_name
1910   - ) =
1911   - [ doctype_w3c_header,
1912   - "<html><head>",
1913   - "<meta http-equiv=\"Refresh\" content=\"0; URL=javascript:void window.open('/?t=','_top')\">",
1914   - "</head><body></body></html>"
1915   - ].
1916   -
1917   -public define Web_Site
1918   - make_web_site_description
1919   - (
1920   - List(String) common_names, // for example: ["www.our-business.com"]
1921   - String site_directory,
1922   - One -> One init,
1923   - (HTTP_Info) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) initial_state,
1924   - ($State expired,
1925   - HTTP_Info,
1926   - List(Web_arg),
1927   - Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) ticket_expired_state,
1928   - (HTTP_Info,
1929   - List(Web_arg),
1930   - Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) ticket_lost_state,
1931   - List(Web_Action($SessionTicket, $State)) actions,
1932   - (Maybe($SessionTicket), Maybe($State)) -> HTML_Page compute_page,
1933   - Int32 timeout,
1934   - List(Redirection) redirections,
1935   - String charset,
1936   - List(String) journal_extensions,
1937   - List(String) journal_headers,
1938   - String secret,
1939   - List(MIME) known_mime_types,
1940   - (String action_name,
1941   - List(Web_arg) args) -> One before_send_file
1942   - ) =
1943   - init(unique);
1944   -
1945   -
1946   - //
1947   - // make required directories (if needed)
1948   - //
1949   - with web_sites_directory = make_directory(my_anubis_directory+"/web_sites"),
1950   - base_directory = make_directory(site_directory),
1951   - state_directory = make_directory(site_directory+"/states"),
1952   - forget(make_directory(site_directory+"/public"));
1953   - //
1954   - // construct tool functions
1955   - //
1956   - with save_state = make_save_state_function(timeout,state_directory),
1957   - retrieve_state = make_retrieve_state_function(state_directory),
1958   - separate_web_args = make_separate_web_args_function(state_directory,retrieve_state),
1959   - apply_action = make_apply_action_function(actions),
1960   - //
1961   - // construct the site handler
1962   - //
1963   - site_handler = (Int32 http_port, Int32 https_port) |->
1964   - ((String host_name,
1965   - HTTP_Info http_info,
1966   - List(Web_arg) lwa,
1967   - Bool is_https) |->
1968   - ((List(HTTP_header),Printable_tree))
1969   - if separate_web_args(lwa) is
1970   - {
1971   - swa(mb_previous_state,mb_action_name,operands) then
1972   - with state_and_headers = if mb_previous_state is
1973   - {
1974   - failure then
1975   - if mb_action_name is
1976   - {
1977   - failure then initial_state(http_info),
1978   - success(action_name) then
1979   - apply_action(failure,action_name,http_info,operands,is_https)
1980   - },
1981   - success(previous_state) then if previous_state is
1982   - {
1983   - not_found then
1984   - if mb_action_name is
1985   - {
1986   - failure then initial_state(http_info),
1987   - success(_) then
1988   - ticket_lost_state(http_info,lwa,is_https)
1989   - },
1990   -
1991   - out_of_date(state) then
1992   - ticket_expired_state(state,http_info,lwa,is_https),
1993   -
1994   - still_valid(state) then
1995   - if mb_action_name is
1996   - {
1997   - failure then (failure, success(state), []),
1998   - success(action_name) then
1999   - apply_action(success(state),action_name,http_info,operands,is_https)
2000   - }
2001   - }
2002   - },
2003   - if state_and_headers is (session_ticket, mb_new_state, headers) then
2004   - with state_name = save_state(mb_new_state),
2005   - (headers,
2006   - format(info(host_name,http_port,https_port,site_directory,secret),
2007   - state_name,compute_page(session_ticket, mb_new_state),is_https,charset))
2008   - }),
2009   - //
2010   - // make the delete_out_of_date function
2011   - //
2012   - delete_out_of_date =
2013   - make_delete_out_of_date_states_function((Maybe($State))failure,
2014   - site_directory+"/states"),
2015   - //
2016   - // construct the web site description
2017   - //
2018   - web_site((Int32 http_port, Int32 https_port) |->
2019   - web_site_description(common_names,
2020   - site_directory,
2021   - redirections,
2022   - charset,
2023   - journal_extensions,
2024   - journal_headers,
2025   - secret,
2026   - known_mime_types,
2027   - site_handler(http_port,https_port),
2028   - (List(Web_arg) lwa) |-> if separate_web_args(lwa) is
2029   - swa(mb_previous_state,mb_action_name,operands) then
2030   - if mb_action_name is
2031   - {
2032   - failure then unique
2033   - success(an) then before_send_file(an,operands)
2034   - }),
2035   - delete_out_of_date).
2036   -
2037   -
2038   -
2039   -
2040   - *** [4.3] Starting the servers.
2041   -
2042   -public define Start_Web_Sites_Result
2043   - start_web_sites
2044   - (
2045   - Int32 ip_address, // the IP address shared by the web sites
2046   - Int32 http_port, // usually: 80
2047   - Int32 https_port, // usually: 443
2048   - String ssl_certificate_common_name,
2049   - List(Web_Site) web_sites, // web sites to be started
2050   - Var(Bool) shutdown_required
2051   - ) =
2052   - with get_description = (Web_Site ws) |-> description(ws)(http_port,https_port),
2053   - with http_server_r =
2054   - start_http_server(ip_address,http_port,
2055   - map(get_description,web_sites),
2056   - load_denial_of_service_info),
2057   - with https_server_r =
2058   - start_https_server(ip_address,https_port,
2059   - ssl_certificate_common_name,
2060   - map(get_description,web_sites),
2061   - load_denial_of_service_info),
2062   - if http_server_r is ok(http_server)
2063   - then
2064   - (
2065   - if https_server_r is ok(https_server)
2066   - then
2067   - (
2068   - start_http_servers_tasks(map(get_description,web_sites),
2069   - [http_server,https_server],
2070   - 600); // period of 10 minutes
2071   - delegate
2072   - delete_states_loop(
2073   - map((Web_Site ws) |->
2074   - (site_directory(description(ws)(http_port,https_port))+
2075   - "/states",delete_out_of_date(ws)),
2076   - web_sites),
2077   - 3600*24*3, // keep out of date states 3 days
2078   - now,
2079   - http_server,
2080   - https_server,
2081   - shutdown_required),
2082   - ok(http_server,https_server)
2083   - )
2084   - else cannot_bind_to_port(https_port)
2085   - )
2086   - else
2087   - (
2088   - if https_server_r is ok(https_server)
2089   - then cannot_bind_to_port(http_port)
2090   - else cannot_bind_to_port(http_port,https_port)
2091   - ).
2092   -
2093   -
2094   -public define One
2095   - start_web_sites
2096   - (
2097   - Int32 ip_address, // the IP address shared by the web sites
2098   - Int32 http_port, // usually: 80
2099   - Int32 https_port, // usually: 443
2100   - String ssl_certificate_common_name,
2101   - List(Web_Site) web_sites, // web sites to be started
2102   - Var(Bool) shutdown_required
2103   - ) =
2104   - if (Start_Web_Sites_Result)start_web_sites(ip_address,
2105   - http_port,
2106   - https_port,
2107   - ssl_certificate_common_name,
2108   - web_sites,
2109   - shutdown_required) is
2110   - {
2111   - cannot_bind_to_port(n) then print("Cannot bind to port: "+n+"\n"),
2112   - cannot_bind_to_port(n,m) then print("Cannot bind to ports: "+n+", "+m+"\n"),
2113   - ok(s1,s2) then print("Servers started.\n")
2114   - }.
2115   -
2116   -
2117   -
2118   -
2119   -
2120   - *** [5] HTML Formating.
2121   -
2122   - We need to translate HTML elements as defined above into actual HTML text.
2123   -
2124   - Actioners require special informations, which must be transmitted when needed by the
2125   - 'format' functions:
2126   -
2127   - - the 'common name', which is used for URLs,
2128   - - the HTTP/HTTPS port number,
2129   - - the 'state name', which must be transmitted when the actioner is clicked upon,
2130   - - the 'form name' (if any) to which the actioner refers.
2131   -
2132   - If the actioner is off form, and if it refers to a form, the name of that form is
2133   - already known by the actioner. On the contrary, if the actioner is 'in form', it refers
2134   - implicitly to the form containing it. The name of that form is transmitted to the
2135   - 'format' functions called from within the formating of that form.
2136   -
2137   -
2138   -
2139   -
2140   - *** [5.1] The type 'HTML_Any($T)'.
2141   -
2142   - The type 'HTML_Any($T)' gathers elements which may be put anywhere in the page. The
2143   - parameter $T becomes either 'HTML_Off_Form' or 'HTML_In_Form'.
2144   -
2145   -type HTML_Any($T):
2146   - any_text (List(Text_Option), String the_text),
2147   - any_preformated (List(Text_Option), String),
2148   - any_paragraph (List(Text_Option), String the_text),
2149   - any_image (String url),
2150   - any_image (String url, Int32 width, Int32 height),
2151   - any_table (List(Table_Option), List(HTML_Row($T))),
2152   - any_center ($T),
2153   - any_mail_to (String email, $T element),
2154   - any_scroller (Int32 width, Int32 height,
2155   - Int32 content_width, Int32 content_height,
2156   - $T content),
2157   - any_fixed_size (HTML_Size width, HTML_Size height, $T content),
2158   - any_fixed_size_2 (HTML_Size width, HTML_Size height, String name_of_HTML_file),
2159   - any_actioner (Actioner_Connection,
2160   - Actioner_Target,
2161   - Actioner_Aspect,
2162   - String action_name,
2163   - List((String,String)) extra_ops,
2164   - List(Actioner_Local_Action),
2165   - Maybe(String) form_name),
2166   - any_foreign_link (List(Text_Option), String url, String name),
2167   - any_private_download (String abs_path, String name, String extra_ext,
2168   - Maybe((String,List((String,String))))),
2169   - any_div (List(DIV_Option), $T element),
2170   - any_div_empty (List(DIV_Option)),
2171   - any_coreattrs (List(CoreAttrs)).
2172   -
2173   -
2174   -
2175   - *** [5.2] Formating a color.
2176   -
2177   - RGB colors are formatted as '#rrggbb' where rr, gg and bb are two characters
2178   - hexadecimal values.
2179   -
2180   -define String
2181   - html_format
2182   - (
2183   - RGB color
2184   - ) =
2185   - if color is rgb(r,g,b) then
2186   - "#" + hexadecimal(word8_to_int32(r),2)
2187   - + hexadecimal(word8_to_int32(g),2)
2188   - + hexadecimal(word8_to_int32(b),2).
2189   -
2190   -
2191   - The following is a very arbitrary definition of the opposite color. The thing which is
2192   - important is that it is far from the original, so that characters in 'opposite' color
2193   - are clearly visible over the original.
2194   -
2195   -define RGB
2196   - opposite
2197   - (
2198   - RGB color
2199   - ) =
2200   - if color is rgb(r,g,b) then
2201   - with r1 = word8_to_int32(r),
2202   - with g1 = word8_to_int32(g),
2203   - with b1 = word8_to_int32(b),
2204   - rgb(truncate_to_word8(255-r1),
2205   - truncate_to_word8(255-g1),
2206   - truncate_to_word8(255-b1)).
2207   -
2208   -
2209   -
2210   -
2211   - *** [5.3] Creating buttons.
2212   -
2213   - We want to be able to create buttons in the form of a pair of images (rollovers)
2214   - automatically. We use the JPEG interface, because for the time being Anubis cannot
2215   - handle other kinds of images.
2216   -
2217   -
2218   - Computing printed text length.
2219   -
2220   - define Int32
2221   - printed_text_width
2222   - (
2223   - Word8 -> Int32 char_size,
2224   - List(Word8) l
2225   - ) =
2226   - if l is
2227   - {
2228   - [] then (Int32) 0,
2229   - [h . t] then char_size(h) + 1+ printed_text_width(char_size,t)
2230   - }.
2231   -
2232   - define Int32
2233   - printed_text_width
2234   - (
2235   - SystemFont font,
2236   - String s
2237   - ) =
2238   - printed_text_width((Word8 c) |-> word8_to_int32(width(get_char_info(font,c))),
2239   - explode(s)).
2240   -
2241   -
2242   -
2243   - Converting RGB to RGBA.
2244   -
2245   -define RGBA
2246   - to_rgba
2247   - (
2248   - RGB color
2249   - ) =
2250   - if color is rgb(r,g,b) then rgba(r,g,b,255).
2251   -
2252   -
2253   - Drawing a 'relief'.
2254   -
2255   - define One
2256   - draw_relief
2257   - (
2258   - RGBAImage dest,
2259   - RGBA color,
2260   - Int32 contrast,
2261   - Int32 x,
2262   - Int32 y,
2263   - Int32 width,
2264   - Int32 height
2265   - ) =
2266   - with l = lighten(color,contrast),
2267   - d = darken(color,contrast),
2268   - draw_rectangle(dest,rect(x,y,x+width,y+1),l);
2269   - draw_rectangle(dest,rect(x,y+1,x+1,y+height),l);
2270   - draw_rectangle(dest,rect(x+width-1,y+1,x+width,y+height),d);
2271   - draw_rectangle(dest,rect(x+1,y+height-1,x+width-1,y+height),d).
2272   -
2273   -
2274   - Creating a button background.
2275   -
2276   - define RGBAImage
2277   - create_button_background
2278   - (
2279   - RGBA color,
2280   - Int32 width,
2281   - Int32 height
2282   - ) =
2283   - with result = create_rgba_image(width,height,color),
2284   - draw_relief(result,color,100,0,0,width,height);
2285   - draw_relief(result,color,70,1,1,width-2,height-2);
2286   - draw_relief(result,color,55,2,2,width-4,height-4);
2287   - draw_relief(result,color,35,3,3,width-6,height-6);
2288   - draw_relief(result,color,20,4,4,width-8,height-8);
2289   - draw_relief(result,color,10,5,5,width-10,height-10);
2290   - draw_relief(result,color,5,6,6,width-12,height-12);
2291   - result.
2292   -
2293   -
2294   - Drawing the text over the background.
2295   -
2296   - define One
2297   - draw_button_text
2298   - (
2299   - RGBAImage image,
2300   - String text,
2301   - Int32 text_index,
2302   - Int32 pixel_x,
2303   - Int32 y,
2304   - Rectangle clip,
2305   - RGBA color,
2306   - SystemFont font,
2307   - ) =
2308   - if nth(text_index,text) is
2309   - {
2310   - failure then unique,
2311   - success(c) then
2312   - with cw = draw_system_character(image,clip,pixel_x,y,font,word8_to_int32(c),color),
2313   - draw_button_text(image,text,text_index+1,pixel_x+cw+1,y,clip,color,font)
2314   - }.
2315   -
2316   - define One
2317   - draw_button_text
2318   - (
2319   - RGBAImage image,
2320   - String text,
2321   - Int32 text_width,
2322   - RGBA light_color,
2323   - RGBA dark_color,
2324   - SystemFont font
2325   - ) =
2326   - with image_width = width(image),
2327   - image_height = height(image),
2328   - x_pos = (image_width-text_width)>>1,
2329   - clip = rect(0,0,image_width,image_height),
2330   - new_light_color = lighten(light_color,150),
2331   - new_dark_color = darken(dark_color,40),
2332   - draw_button_text(image, text, 0, x_pos+2, 16, clip, new_dark_color, font);
2333   - draw_button_text(image, text, 0, x_pos, 14, clip, new_light_color, font).
2334   -
2335   -
2336   - The next function creates the two images for a button. The information given is the
2337   - main color of the button, the text of the button and the minimal width (in pixels) of
2338   - the button. The function does not create the button if the images already exist. The
2339   - two images are stored in the directory 'site_directory/buttons'. The names of the files
2340   - are of the form:
2341   -
2342   - bxxxx_off.jpg
2343   - bxxxx_on.jpg
2344   -
2345   - where the prefix 'b' is to avoid leading '-' which may perturb UNIX commands (like
2346   - 'rm'), and where 'xxxx' is created from the given informations by the formula:
2347   -
2348   - xxxx = web_arg_encode(sha1((color,text,width)))
2349   -
2350   - Hence, distinct informations give distinct file names.
2351   -
2352   -
2353   - define String // returns xxxx
2354   - create_button_images
2355   - (
2356   - String site_directory,
2357   - RGBA color,
2358   - String text,
2359   - Int32 width,
2360   - SystemFont font
2361   - ) =
2362   - with xxxx = web_arg_encode(sha1((color,text,width))),
2363   - buttons_dir = site_directory+"/public/buttons",
2364   - off_filepath = buttons_dir+"/b"+xxxx+"_off.jpg",
2365   - on_filepath = buttons_dir+"/b"+xxxx+"_on.jpg",
2366   - if file_exists(on_filepath)
2367   - then xxxx
2368   - else with
2369   - text_width = printed_text_width(font,text),
2370   - button_width = max(width,text_width+12),
2371   - button_height = (Int32)20,
2372   - light_color = lighten(color,60),
2373   - very_light_color = lighten(light_color,30),
2374   - dark_color = darken(color,40),
2375   - background_off =
2376   - create_button_background(color,button_width,button_height),
2377   - background_on =
2378   - create_button_background(light_color,button_width,button_height),
2379   -
2380   - draw_button_text(background_off,text,text_width,very_light_color,dark_color,font);
2381   - draw_button_text(background_on, text,text_width,very_light_color,dark_color,font);
2382   - forget(write_image_to_JPEG_file(to_JPEG(background_off),
2383   - off_filepath,
2384   - 100));
2385   - forget(write_image_to_JPEG_file(to_JPEG(background_on),
2386   - on_filepath,
2387   - 100));
2388   - xxxx.
2389   -
2390   -
2391   -
2392   -
2393   -
2394   - *** [5.4] Formating an actioner.
2395   -
2396   - An actioner works as follows. Assume first that it refers to a form. When it is clicked
2397   - upon, the actioner puts (via 'onMouseDown') the URL into the 'action' attribute of the
2398   - form, and submits the form, using the JavaScript command 'form_name.submit()'. If the
2399   - actioner does not refer to a form, it fires the URL directly via 'href', because in
2400   - that case, the actioner is always an <a> tag.
2401   -
2402   - The URL itself is composed using the connection sort (same, http or https), the common
2403   - name and port number (if needed), the state name, the action name, and the extra
2404   - operands, which are put into a query string. It may look like this:
2405   -
2406   - http://common_name:port/?s=state_name&a=action_name&oname=value...
2407   -
2408   - Each extra operand is a pair of strings: (name,value). It is formated as:
2409   -
2410   - &oname=value
2411   -
2412   -
2413   -define String
2414   - format_extra_operands
2415   - (
2416   - List((String,String)) l
2417   - ) =
2418   - if l is
2419   - {
2420   - [ ] then "",
2421   - [h . t] then if h is (n,v) then
2422   - "&amp;o"+n+"="+v+format_extra_operands(t)
2423   - }.
2424   -
2425   -
2426   - It seams that the standard requires "&amp;" instead of "&" !
2427   -
2428   - In case the target is another window, we need to format the options for this window.
2429   -
2430   -define String
2431   - format
2432   - (
2433   - List(Other_Window_Option) l
2434   - ) =
2435   - if l is
2436   - {
2437   - [ ] then "",
2438   - [h . t] then if h is
2439   - {
2440   - resizable then "resizable",
2441   - scrollbars then "scrollbars",
2442   - width(w) then "width="+w,
2443   - height(h) then "height="+h
2444   - } + if t is [ ] then "" else (","+format(t))
2445   - }.
2446   -
2447   -
2448   -
2449   - Formating choices for a <select> tag.
2450   -
2451   -public define Printable_tree
2452   - format_choices
2453   - (
2454   - List(String) l
2455   - ) =
2456   - if l is
2457   - {
2458   - [ ] then [ ],
2459   - [h . t] then ["<option>",h . format_choices(t)]
2460   - }.
2461   -
2462   -
2463   -public define Printable_tree
2464   - format_choices
2465   - (
2466   - List(String) l,
2467   - String selected
2468   - ) =
2469   - if l is
2470   - {
2471   - [ ] then [ ],
2472   - [h . t] then if h = selected
2473   - then ["<option selected>",h . format_choices(t)]
2474   - else ["<option>",h . format_choices(t,selected)]
2475   - }.
2476   -
2477   -
2478   -public define Printable_tree
2479   - format_choices
2480   - (
2481   - List((String,String)) l
2482   - ) =
2483   - if l is
2484   - {
2485   - [ ] then [ ],
2486   - [h . t] then
2487   - if h is (val,item)
2488   - then ["<option value=\""+val+"\">",item . format_choices(t)]
2489   - }.
2490   -
2491   -public define Printable_tree
2492   - format_choices
2493   - (
2494   - List((String,String)) l,
2495   - String selected
2496   - ) =
2497   - if l is
2498   - {
2499   - [ ] then [ ],
2500   - [h . t] then
2501   - if h is (val,item) then
2502   - if item = selected
2503   - then ["<option value=\""+val+"\" selected>",item . format_choices(t)]
2504   - else ["<option value=\""+val+"\">",item . format_choices(t,selected)]
2505   - }.
2506   -
2507   -
2508   -
2509   -variable Int32 count = 0.
2510   -
2511   - Note: this counter is private to the virtual machine, hence there is one counter by
2512   - client.
2513   -
2514   -define Int32
2515   - new_count
2516   - =
2517   - count <- *count+1;
2518   - *count.
2519   -
2520   -
2521   - The next function composes the URL. It is a JavaScript URL when the target is another
2522   - window.
2523   -
2524   -define String
2525   - make_actioner_url
2526   - (
2527   - CommonInfo cinfo,
2528   - Actioner_Connection connection,
2529   - Actioner_Target target,
2530   - String state_name,
2531   - String action_name,
2532   - List((String,String)) extra_ops,
2533   - Bool is_https
2534   - ) =
2535   - if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
2536   - with strict_url =
2537   - if connection is
2538   - {
2539   - same then "/",
2540   - /*
2541   - same then if is_https
2542   - then "https://"+common_name+":"+https_port+"/"
2543   - else "http://"+common_name+":"+https_port+"/",
2544   - */
2545   -
2546   - http then "http://"+common_name+":"+http_port+"/",
2547   - https then "https://"+common_name+":"+https_port+"/",
2548   - } +
2549   - "?s=" + state_name + "&amp;a=" + action_name +
2550   - format_extra_operands(extra_ops),
2551   - if target is
2552   - {
2553   - same then strict_url,
2554   - same(label) then strict_url+"#"+label,
2555   - other(wn,ops) then
2556   - "javascript:void window.open('"+strict_url+"&amp;t="+wn+"','"+
2557   - "w"+to_ascii(sha1(wn))+"','"+format(ops)+"')"
2558   - }.
2559   -
2560   -
2561   - Depending on the fact that the actioner refers to a form or not, the URL is used in two
2562   - different ways. If the actioner does not refer to a form, it is realized by a '<a>'
2563   - tag, with a 'href' attribute. If it refers to a form, it is still realized by a '<a>'
2564   - tag, but with no href attribute. In this case, we use the 'onMouseDown' or 'onChange'
2565   - event handler. The handler calls a JavaScript function which puts the URL as the value
2566   - of the 'action' attribute of the form, and submits the form.
2567   -
2568   -type URL_or_JavaScript:
2569   - url (String),
2570   - javascript (Printable_tree script, Printable_tree handler).
2571   -
2572   - define URL_or_JavaScript
2573   - format_action
2574   - (
2575   - String the_url,
2576   - Maybe(String) mb_form_name
2577   - ) =
2578   - url(the_url).
2579   -
2580   -
2581   - It was as shown below, in order to allow submission of a form from outside the form,
2582   - but this makes problems:
2583   -
2584   -define URL_or_JavaScript
2585   - format_action
2586   - (
2587   - String the_url,
2588   - Maybe(String) mb_form_name
2589   - ) =
2590   - if mb_form_name is
2591   - {
2592   - failure then
2593   - url(the_url),
2594   - success(form_name) then
2595   - with n = new_count,
2596   - javascript(
2597   - [
2598   - "<script type=\"text/javascript\" language =\"JavaScript\">\n",
2599   - "function pfu",form_name,n,"() {\n",
2600   - " var fa = document.forms.f",form_name,";\n",
2601   - " var u = \"",the_url,"\";\n",
2602   - " fa.action = u;\n",
2603   - " fa.submit(); }",
2604   - "</script>"
2605   - ],
2606   - ["pfu",form_name,n,"();"]
2607   - )
2608   - }.
2609   -
2610   -
2611   -
2612   - Now, we format the actioner according to its aspect.
2613   -
2614   -define List(Text_Option)
2615   - get_text_options
2616   - (
2617   - List(Text_Option) l
2618   - )
2619   - =
2620   - if l is
2621   - {
2622   - [] then [],
2623   - [h . t ] then
2624   - if h is class(class) then
2625   - get_text_options(t)
2626   - else
2627   - [ h . get_text_options(t) ]
2628   -
2629   - }.
2630   -
2631   - /**
2632   - * Extract the CSS class list from the list of Text_Option
2633   - */
2634   -define List(Text_Option)
2635   - get_css_class
2636   - (
2637   - List(Text_Option) l
2638   - )
2639   - =
2640   - if l is
2641   - {
2642   - [] then [],
2643   - [h . t ] then
2644   -
2645   -
2646   - if h is class(class) then
2647   - [ h . get_css_class(t) ]
2648   - else
2649   - get_css_class(t)
2650   - }
2651   - .
2652   -
2653   -define String
2654   - format_text_options
2655   - (
2656   - List(Text_Option) l
2657   - )
2658   - =
2659   - with text_options = get_text_options(l),
2660   - css_classes = get_css_class(l),
2661   - if text_options is
2662   - {
2663   - [] then "",
2664   - [_._] then " style=\"" + format(text_options) + "\" "
2665   - }
2666   - +
2667   - if css_classes is
2668   - {
2669   - [] then "",
2670   - [_._] then format(css_classes)
2671   - }.
2672   -
2673   -define Printable_tree
2674   - format
2675   - (
2676   - List(Actioner_Local_Action) l
2677   - ) =
2678   - if l is
2679   - {
2680   - [ ] then [ ],
2681   - [h . t] then [if h is
2682   - {
2683   - close_window then [" window.close(); "]
2684   - }
2685   - . format(t)]
2686   - }.
2687   -
2688   -define String
2689   - format_coreattrs
2690   - (
2691   - List(CoreAttrs) attributs
2692   - )=
2693   - if attributs is
2694   - {
2695   - [] then "",
2696   - [h .t] then
2697   - with current = if h is
2698   - {
2699   - id(id_name) then
2700   - " id=\"" + id_name + "\"",
2701   - class(class_name) then
2702   - " class=\"" + class_name + "\"",
2703   - style(style_string) then
2704   - " style=\"" + style_string + "\"",
2705   -
2706   - title(title_string) then
2707   - " title=\"" + title_string + "\"",
2708   - },
2709   - current + format_coreattrs(t)
2710   - }.
2711   -
2712   -define String
2713   - _format
2714   - (
2715   - List(DIV_Option) opt
2716   - )=
2717   - if opt is
2718   - {
2719   - [] then "",
2720   - [h .t] then
2721   - with current = if h is
2722   - {
2723   - id(id_name) then
2724   - " id=\"" + id_name + "\"",
2725   - class(class_name) then
2726   - " class=\"" + class_name + "\"",
2727   - style(style_string) then
2728   - " style=\"" + style_string + "\"",
2729   -
2730   - title(title_string) then
2731   - " title=\"" + title_string + "\"",
2732   - lang(lang) then
2733   - " xml:lang=" + lang,
2734   - dir(reading_Way) then
2735   - if reading_Way is
2736   - {
2737   - ltr then " dir=ltr",
2738   - rtl then " dir=rtl"
2739   - }
2740   - },
2741   - current + _format(t)
2742   - }
2743   - .
2744   -
2745   -define Printable_tree
2746   - format_div_option
2747   - (
2748   - List(DIV_Option) options
2749   - )=
2750   - ["<DIV" + _format(options) + ">"] .
2751   -
2752   -
2753   -define Printable_tree
2754   - format_actioner
2755   - (
2756   - CommonInfo cinfo,
2757   - String state_name,
2758   - Actioner_Connection connection,
2759   - Actioner_Target target,
2760   - Actioner_Aspect aspect,
2761   - String action_name,
2762   - List((String,String)) extra_ops,
2763   - List(Actioner_Local_Action) local_actions,
2764   - Maybe(String) mb_form_name,
2765   - Bool is_https,
2766   - ) =
2767   - if cinfo is info(common_name,http_port,https_port,site_dir,secret) then
2768   - with url = make_actioner_url(cinfo,connection,target,
2769   - state_name,action_name,extra_ops,is_https),
2770   - with action = format_action(url,mb_form_name),
2771   - if aspect is
2772   - {
2773   -
2774   - link(opt, text) then [
2775   - if action is
2776   - {
2777   - url(u) then
2778   - ["<a href=\"",u,"\"", format_text_options(opt), ">"],
2779   -// ["<a href=\"",u,"\" style=\"",format(reverse(opt)),"\">"],
2780   - javascript(s,h) then
2781   - [s,"<a href=\"javascript: ",h,"\">"]
2782   - },
2783   - text,
2784   - "</a>"
2785   - ],
2786   -
2787   - push_button(options, text) then
2788   - [
2789   - if action is
2790   - {
2791   - url(u) then ["<a href=\"",u,"\"", format_coreattrs(options), ">",
2792   - text, "</a>"
2793   - ],
2794   - javascript(s,h) then
2795   - [s,"<INPUT TYPE =\"button\" Value=\"",text,"\"", format_coreattrs(options), " onClick=\"",h,"\">"]
2796   - }
2797   - ],
2798   -
2799   - button(url_off,url_on) then
2800   - [ if action is
2801   - {
2802   - url(u) then ["<a href=\"",u],
2803   - javascript(s,h) then [s,"<a onMouseDown=\"",h]
2804   - },
2805   - "\" style=\"text-decoration:none\">",
2806   - "<img alt=\"",url_off,"\" src=\"",url_off,"\" border=0",
2807   - " onMouseOver=\"this.src='",url_on,"'\" ",
2808   - " onMouseOut=\"this.src='",url_off,"'\">",
2809   - "</a>"
2810   - ],
2811   -
2812   - button(url_off,url_on,w,h) then
2813   - [ if action is
2814   - {
2815   - url(u) then ["<a href=\"",u],
2816   - javascript(s,h) then [s,"<a onMouseDown=\"",h]
2817   - },
2818   - "\" style=\"text-decoration:none\">",
2819   - "<img width=",w," height=",h," alt=\"",url_off,"\" src=\"",url_off,"\" border=0",
2820   - " onMouseOver=\"this.src='",url_on,"'\" ",
2821   - " onMouseOut=\"this.src='",url_off,"'\">",
2822   - "</a>"
2823   - ],
2824   -
2825   - immediate_selector(name,size,choices) then
2826   - [ if action is
2827   - {
2828   - url(u) then ["<select href=\"",u]
2829   - javascript(s,h) then [s,"<select onchange=\"",h]
2830   - },
2831   - "\" name=o",name," size=",size,">",
2832   - format_choices(choices),"</select>"
2833   - ]
2834   - }.
2835   -
2836   -
2837   -define Printable_tree
2838   - format_local_popup_button
2839   - (
2840   - CommonInfo cinfo,
2841   - Actioner_Aspect aspect,
2842   - Int32 n,
2843   - ) =
2844   - if cinfo is info(common_name,http_port,https_port,site_dir,secret) then
2845   - [ "<script type=\"text/javascript\" language=\"JavaScript\">",
2846   - " var lpust_",n," = new Array(); ",
2847   - " lpust_",n,"[0] = 0; ",
2848   - "</script>",
2849   - "<a href=\"javascript:show_local_popup('lpu_",n,"','lpust_",n,"');\">",
2850   - if aspect is
2851   - {
2852   - link(opt,text) then [text],
2853   - push_button(opt, text) then [text],
2854   - button(url_off,url_on) then
2855   - [
2856   - "<img alt=\"",url_off,"\" src=\"",url_off,"\" border=0",
2857   - " onMouseOver=\"this.src='",url_on,"'\" ",
2858   - " onMouseOut=\"this.src='",url_off,"'\">",
2859   - ],
2860   -
2861   - button(url_off,url_on,w,h) then
2862   - [
2863   - "<img width=",w," height=",h," alt=\"",url_off,"\" src=\"",url_off,"\" border=0",
2864   - " onMouseOver=\"this.src='",url_on,"'\" ",
2865   - " onMouseOut=\"this.src='",url_off,"'\">",
2866   - ],
2867   -
2868   - immediate_selector(name,size,choices) then alert,
2869   -
2870   - },
2871   - "</a>"].
2872   -
2873   -
2874   -
2875   -
2876   -
2877   - *** [5.5] Formating a private download link.
2878   -
2879   - We get the absolute path of the file to be downloaded, and the name under which it
2880   - should appear to the client. The function 'format_private_download' creates an
2881   - hypertext link for downloading the file. The secured mecanism of private download is
2882   - used. This function is called by the function which formats HTML_Any($T) elements.
2883   -
2884   -
2885   -define Printable_tree
2886   - format_private_download
2887   - (
2888   - CommonInfo cinfo,
2889   - String sn, // state name
2890   - String abs_path, // absolute file path on server
2891   - String name, // name of file as it appears in the browser
2892   - String extra, // extra extension
2893   - Maybe((String,List((String,String)))) action
2894   -
2895   - ) =
2896   - if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
2897   - with private_download_directory = site_directory+"/private_download",
2898   - with auth = make_authorization(site_directory,secret,abs_path),
2899   - [
2900   - "<a href=\"",name,extra,"?zauth=",auth,
2901   - if action is
2902   - {
2903   - failure then [ ]
2904   - success(a) then if a is (an,args) then
2905   - ["&amp;a=",an,format_extra_operands(args)]
2906   - },
2907   - "\">",
2908   - name,
2909   - "</a>"
2910   - ].
2911   -
2912   -
2913   -
2914   -
2915   - *** [5.6] Formating rows and cells in a table.
2916   -
2917   -define Int32
2918   - percent
2919   - (
2920   - Int32 p
2921   - ) =
2922   - if p < 0 then 0 else if p > 100 then 100 else p.
2923   -
2924   -
2925   -
2926   -
2927   - Formating cell options.
2928   -
2929   -
2930   -
2931   -define String
2932   - format
2933   - (
2934   - BackgroundOption o
2935   - ) =
2936   - if o is
2937   - {
2938   - repeat then "",
2939   - repeat_horizontal then "; background-repeat: repeat-x",
2940   - repeat_vertical then "; background-repeat: repeat-y",
2941   - no_repeat then "; background-repeat: no-repeat",
2942   - center then "; background-position: center top"
2943   - }.
2944   -
2945   -define String
2946   - format
2947   - (
2948   - List(BackgroundOption) l
2949   - ) =
2950   - if l is
2951   - {
2952   - [ ] then "",
2953   - [h . t] then format(h)+format(t)
2954   - }.
2955   -
2956   -
2957   -define String
2958   - format
2959   - (
2960   - List(Cell_Option) options
2961   - ) =
2962   - if options is
2963   - {
2964   - [ ] then "",
2965   - [h . t] then
2966   - if h is
2967   - {
2968   - left then " align=left",
2969   - h_center then " align=center",
2970   - right then " align=right",
2971   - top then " valign=top",
2972   - v_center then " valign=middle",
2973   - bottom then " valign=bottom",
2974   - base_line then " valign=baseline",
2975   - background_color(c) then " bgcolor=\""+html_format(c)+"\"",
2976   - background_image(n,o) then " style=\"background: url("+n+")"+format(o)+"\"",
2977   - width(w) then " width=\""+w+"\"",
2978   - percentage_width(n) then " width=\""+percent(n)+"%\"",
2979   - height(h) then " height="+h,
2980   - columns(n) then " colspan="+n,
2981   - rows(n) then " rowspan="+n,
2982   - nowrap then " nowrap"
2983   - }
2984   - + format(t)
2985   - }.
2986   -
2987   -
2988   - Normalizing a list of cell options (horizontal position must be specified; the default
2989   - is 'left').
2990   -
2991   -define List(Cell_Option)
2992   - normalize
2993   - (
2994   - List(Cell_Option) l
2995   - ) =
2996   - if member(l,left) then l else
2997   - if member(l,h_center) then l else
2998   - if member(l,right) then l else
2999   - [left . l].
3000   -
3001   -
3002   - Formating cells in a row.
3003   -
3004   -define Printable_tree
3005   - format
3006   - (
3007   - List(HTML_Cell($T)) cells,
3008   - $T -> Printable_tree format_element
3009   - ) =
3010   - if cells is
3011   - {
3012   - [ ] then [ ],
3013   - [h . t] then if h is cell(options,element) then
3014   - ["<td ",format(reverse(normalize(options))),">",
3015   - format_element(element),
3016   - "</td>"
3017   - . format(t,format_element)]
3018   - }.
3019   -
3020   -
3021   - Formating the rows in a table.
3022   -
3023   -define Printable_tree
3024   - format
3025   - (
3026   - List(HTML_Row($T)) rows,
3027   - $T -> Printable_tree format_element,
3028   - ) =
3029   - if rows is
3030   - {
3031   - [ ] then [ ],
3032   - [h . t] then if h is row(options,cells) then
3033   - ["<tr ",format(reverse(options)),">",
3034   - format(cells,format_element),
3035   - "</tr>"
3036   - . format(t,format_element)]
3037   - }.
3038   -
3039   -
3040   -
3041   -define Printable_tree
3042   - format1
3043   - (
3044   - List(TextAreaOption) l
3045   - ) =
3046   - if l is
3047   - {
3048   - [] then [],
3049   - [h . t] then if h is
3050   - {
3051   - disabled then [" disabled " . format1(t)]
3052   - read_only then [" readonly " . format1(t)]
3053   - wrap_lines then [" wrap " . format1(t)]
3054   - }
3055   - }.
3056   -
3057   -define Printable_tree
3058   - format
3059   - (
3060   - List(TextAreaOption) l
3061   - ) =
3062   - if member(l,wrap_lines)
3063   - then format1(l)
3064   - else [" wrap=off " . format1(l)].
3065   -
3066   -
3067   - *** [5.7] Formating elements which may be put anywhere.
3068   -
3069   - The function below involves the parameter $T which is later instantiated as
3070   - 'HTML_In_Form' or as 'HTML_Off_Form'. Now, since there are dictinct 'format' functions
3071   - for these two types, and because formating of tables requires recursive calls of such
3072   - functions, it is necessary to provide the 'format' function to be called recursively as
3073   - an argument. Putting naively a call to 'format' will not work, because the compiler
3074   - will look for a function able to format data of type $T (which is at that time distinct
3075   - from any other type, including our two types). Such a function does not exist. Hence
3076   - the function to be called for formating elements must be passed as a functional
3077   - argument (called 'format_element' below). Actually, what we pass is a function taking
3078   - a unique argument of type $T. Other informations (like the name of the state) are
3079   - already in the function by way of full functionality.
3080   -
3081   -
3082   - Formating text options. They are formated in CSS syntax, to be used within a
3083   - 'style=...'.
3084   -
3085   -define String
3086   - format
3087   - (
3088   - List(Text_Option) l
3089   - ) =
3090   - if l is
3091   - {
3092   - [ ] then "",
3093   - [h . t] then if h is
3094   - {
3095   - size(n) then "font-size:"+n+"pt",
3096   - font(fn) then "font-family:"+fn,
3097   - color(c) then if c is rgb(r,g,b) then
3098   - "color:rgb("+word8_to_int32(r)+","+word8_to_int32(g)+","+word8_to_int32(b)+")",
3099   - italic then "font-style:italic",
3100   - oblique then "font-style:oblique",
3101   - small_capitals then "font-variant:small-caps",
3102   - bold then "font-weight:bold",
3103   - underlined then "text-decoration:underline",
3104   - left_justified then "text-align:left",
3105   - right_justified then "text-align:right",
3106   - justified then "text-align:justify",
3107   - line_through then "text-decoration:line-through",
3108   - nowrap then "white-space:nowrap",
3109   - class(class_name)then " class=\"" +class_name +"\""
3110   - } + if t is [ ] then "" else ("; "+format(t))
3111   - }.
3112   -
3113   -
3114   -
3115   - Formating table options.
3116   -
3117   -define String
3118   - format
3119   - (
3120   - List(Table_Option) l,
3121   - Bool border_seen
3122   - ) =
3123   - if l is
3124   - {
3125   - [ ] then if border_seen then "" else " border=0 cellspacing=0 cellpadding=0",
3126   - [h . t] then if h is
3127   - {
3128   - background_color(c) then " bgcolor=\""+html_format(c)+"\""+format(t,border_seen),
3129   - background_image(url) then " background="+url+format(t,border_seen),
3130   - border(o,top,i,c) then " border="+o+" cellspacing="+top+" cellpadding="+i+
3131   - //" bordercolor="+format(c)+
3132   - format(t,true),
3133   - width(w) then " width=\""+w+"\""+format(t,border_seen),
3134   - percentage_width(p) then " width=\""+percent(p)+"%\""+format(t,border_seen),
3135   - }
3136   - }.
3137   -
3138   -
3139   -
3140   -
3141   -
3142   -define Printable_tree
3143   - format_scroller
3144   - (
3145   - String sn,
3146   - Int32 width,
3147   - Int32 height,
3148   - Int32 content_width,
3149   - Int32 content_height,
3150   - Int32 idnum, // identifying the scroller
3151   - $T content,
3152   - $T -> Printable_tree format_element
3153   - ) =
3154   - [
3155   - "<script type = \"text/javascript\" language=\"JavaScript\">",
3156   - "function doscroll_",idnum,"(dx,dy) {\n",
3157   - " if (document.layers) { var c_",idnum," = eval(document.cs_",idnum,"); } else\n",
3158   - " if (document.getElementById) {var c_",idnum," = eval(\"document.getElementById('cs_",
3159   - idnum,"').style\"); } else\n",
3160   - " if (document.all) { var c_",idnum," = eval(document.all.cs_",idnum,".style); };\n",
3161   - " var x_",idnum," = parseInt(c_",idnum,".left);\n",
3162   - " var y_",idnum," = parseInt(c_",idnum,".top);\n",
3163   - " if ((x_",idnum,"+dx <= 0) && (x_",idnum,"+dx > ",width-content_width,"))\n",
3164   - " { x_",idnum," += dx; }\n",
3165   - " if ((y_",idnum,"+dy <= 0) && (y_",idnum,"+dy > ",height-content_height,"))\n",
3166   - " { y_",idnum," += dy; }\n",
3167   - " c_",idnum,".left = x_",idnum,";\n",
3168   - " c_",idnum,".top = y_",idnum,";\n",
3169   - " }\n",
3170   - "</script>",
3171   - "<table>",
3172   - "<tr>",
3173   - "<td align=left valign=top",
3174   - " width=",width,
3175   - " height=",height,
3176   - ">",
3177   - "<div id=\"ws_",idnum,"\" style=\"position:absolute; width:",width,"px; height:",height,"px;",
3178   - " clip:rect(0px ",width,"px ",height,"px 0px)\">",
3179   - "<div id=\"cs_",idnum,"\" style=\"position:absolute; left:0px; top:0px\">",
3180   - format_element(content),
3181   - "</div>",
3182   - "</div>",
3183   - "</td>",
3184   - "<td valign=bottom>",
3185   - "<table>",
3186   - "<tr><td><img alt=\"sroll up\" src=\"scrollup.gif\" onMouseDown=\"doscroll_",
3187   - idnum,"(0,20);\"></td></tr>",
3188   - "<tr><td><img alt=\"scroll down\" src=\"scrolldown.gif\" onMouseDown=\"doscroll_",
3189   - idnum,"(0,-20);\"></td></tr>",
3190   - "</table>",
3191   - "</td>",
3192   - "</tr>",
3193   - (if content_width > width then
3194   - [
3195   - "<tr>",
3196   - "<td align=right>",
3197   - "<table>",
3198   - "<tr>",
3199   - "<td><img alt=\"scroll left\" src=\"scrollleft.gif\" onMouseDown=\"doscroll_",
3200   - idnum,"(20,0);\"></td>",
3201   - "<td><img alt=\"scroll right\" src=\"scrollright.gif\" onMouseDown=\"doscroll_",
3202   - idnum,"(-20,0);\"></td>",
3203   - "</tr>",
3204   - "</table>",
3205   - "</td>",
3206   - "</tr>",
3207   - ] else [ ]),
3208   - "</table>"
3209   - ].
3210   -
3211   -
3212   -
3213   - define Printable_tree
3214   - popup_topbar
3215   - (
3216   - CommonInfo cinfo,
3217   - String title,
3218   - RGB color,
3219   - Int32 width,
3220   - ) =
3221   - if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
3222   - with xxxx = web_arg_encode(sha1((title,color,width))),
3223   - path = site_directory+"/public/buttons/t"+xxxx+".jpg",
3224   - result = (Printable_tree)["<img alt=\"button\" src=\"buttons/t"+xxxx+".jpg\">"],
3225   - if file_exists(path) then result else
3226   - with col = to_rgba(color),
3227   - bg = create_button_background(col,width,20),
3228   - very_light_color = lighten(col,70),
3229   - dark_color = darken(col,40),
3230   - title_width = printed_text_width(font,title),
3231   - draw_button_text(bg,title,title_width,very_light_color,dark_color,font);
3232   - forget(write_image_to_JPEG_file(to_JPEG(bg),path,100));
3233   - result.
3234   -
3235   -
3236   - define Printable_tree
3237   - popup_close_button
3238   - (
3239   - CommonInfo cinfo,
3240   - RGB color,
3241   - String div_name,
3242   - String state_var_name,
3243   - ) =
3244   - if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
3245   - with xxxx = web_arg_encode(sha1(color)),
3246   - path_on = site_directory+"/public/buttons/c"+xxxx+"_on.jpg",
3247   - path_off = site_directory+"/public/buttons/c"+xxxx+"_off.jpg",
3248   - result = (Printable_tree)["<img alt=\"button\" src=\"buttons/c"+xxxx+"_off.jpg\"",
3249   - " onMouseOver=\"this.src='buttons/c"+xxxx+"_on.jpg'\"",
3250   - " onMouseOut=\"this.src='buttons/c"+xxxx+"_off.jpg'\"",
3251   - " onMouseDown=\"show_local_popup('",div_name,"','",state_var_name,"')\">"],
3252   - if file_exists(path_on) then result else
3253   - with col = to_rgba(color),
3254   - title = "x",
3255   - title_width = printed_text_width(font,title),
3256   - bg_on = create_button_background(lighten(col,30),20,20),
3257   - bg_off = create_button_background(col,20,20),
3258   - very_light_color = lighten(col,70),
3259   - dark_color = darken(col,40),
3260   - draw_button_text(bg_on,title,title_width,very_light_color,dark_color,font);
3261   - draw_button_text(bg_off,title,title_width,very_light_color,dark_color,font);
3262   - forget(write_image_to_JPEG_file(to_JPEG(bg_on),path_on,100));
3263   - forget(write_image_to_JPEG_file(to_JPEG(bg_off),path_off,100));
3264   - result.
3265   -
3266   -
3267   -
3268   -
3269   -
3270   - The function below formats a datum of type 'HTML_Any($T)'.
3271   -
3272   -define Printable_tree
3273   - format
3274   - (
3275   - CommonInfo cinfo,
3276   - String sn, // state_name
3277   - Var(Int32) ic_v,
3278   - HTML_Any($T) element,
3279   - $T -> Printable_tree format_element, // able to format a datum of type $T
3280   - Bool is_https,
3281   - ) =
3282   - if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
3283   - if element is
3284   - {
3285   - any_text(opts,t) then
3286   - ["<span ", format_text_options(opts), ">",t,"</span>"],
3287   - any_preformated(opts,s) then
3288   - ["<span ", format_text_options(opts), "><pre>",s,"</pre></span>"],
3289   - //["<pre>",s,"</pre>"],
3290   - any_paragraph(opts,t) then
3291   - ["<p ", format_text_options(opts), ">",t,"</p>"],
3292   - any_image(url) then
3293   - ["<img alt=\"",url,"\" src=\"",url,"\">"],
3294   - any_image(url,w,h) then
3295   - ["<img alt=\"",url,"\" src=\"",url,"\" width=",w," height=",h,">"],
3296   - any_table(opts,rows) then
3297   - ["<table ",format(reverse(opts),false),">",format(rows,format_element),"</table>"],
3298   - any_center(e) then
3299   - ["<center>",format_element(e),"</center>"],
3300   - any_mail_to(email,elem) then
3301   - ["<a href=\"mailto:",email,"\">",format_element(elem),"</a>"],
3302   - any_scroller(w,h,cw,ch,c) then
3303   - format_scroller(sn,w,h,cw,ch,new_idnum(ic_v),c,format_element),
3304   - any_fixed_size(w,h,c) then
3305   - with url = create_secondary_document(site_directory,secret,sn,format_element,c,w),
3306   - ["<object data=\"",url,"\" type=\"text/html\" width=",format(w)," height=",format(h)," >",
3307   - "secondary document",
3308   - "</object>"],
3309   - any_fixed_size_2(w,h,fn) then
3310   - with url = fn+"?zauth="+make_authorization(site_directory,secret,
3311   - fn),
3312   - ["<object data=\"",url,"\" type=\"text/html\" width=",format(w)," height=",format(h)," >",
3313   - "secondary document",
3314   - "</object>"],
3315   - any_actioner(c,t,a,an,eo,ja,fn) then
3316   - format_actioner(cinfo,sn,c,t,a,an,eo,ja,fn,is_https),
3317   - any_foreign_link(options,url,name) then
3318   - ["<a href=\"",url,"\"><span ", format_text_options(options), ">",name,"</span></a>"],
3319   - any_private_download(url,name,extra_ext,action) then
3320   - format_private_download(cinfo,sn,url,name,extra_ext,action),
3321   - any_div(options, e) then
3322   - [format_div_option(options), format_element(e),"</DIV>"],
3323   - any_div_empty(options) then
3324   - [format_div_option(options), "</DIV>"],
3325   - any_coreattrs(attributs) then
3326   - [format_coreattrs(attributs)]
3327   - }.
3328   -
3329   -
3330   -
3331   -
3332   - *** [5.8] Formating 'in form' elements.
3333   -
3334   -
3335   -
3336   -
3337   -
3338   -define Printable_tree
3339   - format
3340   - (
3341   - CommonInfo cinfo,
3342   - String fn, // form_name
3343   - String sn, // state_name
3344   - Var(Int32) ic_v, // idnum counter variable
3345   - HTML_In_Form element,
3346   - Bool is_https,
3347   - ) =
3348   - if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
3349   - with format_element = (HTML_In_Form e) |-> format(cinfo,fn,sn,ic_v,e,is_https),
3350   - if element is
3351   - {
3352   - literal_pt(t) then t,
3353   - literal(t) then [t],
3354   - sequence(l) then flat(map(format_element,l))
3355   - text(opts,t) then
3356   - format(cinfo,sn,ic_v,any_text(opts,t),format_element,is_https),
3357   - preformated(o,s) then
3358   - format(cinfo,sn,ic_v,any_preformated(o,s),format_element,is_https),
3359   - paragraph(opts,t) then
3360   - format(cinfo,sn,ic_v,any_paragraph(opts,t),format_element,is_https),
3361   - image(url) then
3362   - format(cinfo,sn,ic_v,any_image(url),format_element,is_https),
3363   - image(url,w,h) then
3364   - format(cinfo,sn,ic_v,any_image(url,w,h),format_element,is_https),
3365   - table(opts,rows) then
3366   - format(cinfo,sn,ic_v,any_table(opts,rows),format_element,is_https),
3367   - center(e) then
3368   - format(cinfo,sn,ic_v,any_center(e),format_element,is_https),
3369   - mail_to(a,e) then
3370   - format(cinfo,sn,ic_v,any_mail_to(a,e),format_element,is_https),
3371   - scroller(w,h,cw,ch,c) then
3372   - format(cinfo,sn,ic_v,any_scroller(w,h,cw,ch,c),format_element,is_https),
3373   - actioner(c,t,a,an,eo,ja) then
3374   - format(cinfo,sn,ic_v,any_actioner(c,t,a,an,eo,ja,success(fn)),format_element,is_https),
3375   - foreign_link(options,url,name) then
3376   - format(cinfo,sn,ic_v,any_foreign_link(options,url,name),format_element,is_https),
3377   - private_download(url,name,extra,action) then
3378   - format(cinfo,sn,ic_v,any_private_download(url,name,extra,action),format_element,is_https),
3379   - text_input(label_text, label, name,i,w) then
3380   - [ "<label for=\"",label,"\">",label_text,"</label>",
3381   - "<input type=text name=o",name," id=",label," size=",w," value=\"",i,"\">"],
3382   - //["&nbsp; <input type=text name=o",n," size=",w," value=\"",i,"\">"],
3383   - password_input(label_text, label, name,w) then
3384   - [ "<label for=\"",label,"\">",label_text,"</label>",
3385   - "<input type=password name=p",name," id=",label," size=",w,">"],
3386   - //["&nbsp; <input type=password name=p",n," size=",w,">"],
3387   - text_area(opts,n,i,w,h) then
3388   - ["<textarea ",format(opts)," name=o",n," cols=",w," rows=",h,">",i,"</textarea>"],
3389   - file_upload(n,w) then
3390   - ["<input type=file size=",w," name=o",n,">"],
3391   - selector(n,s,cs) then
3392   - ["<select name=o",n," size=",s,">",format_choices(cs),"</select>"],
3393   - selector(n,s,cs,sd) then
3394   - ["<select name=o",n," size=",s,">",format_choices(cs,sd),"</select>"],
3395   - selector_c(n,s,cs) then
3396   - ["<select name=o",n," size=",s,">",format_choices(cs),"</select>"],
3397   - selector_c(n,s,cs,sd) then
3398   - ["<select name=o",n," size=",s,">",format_choices(cs,sd),"</select>"],
3399   -
3400   - radio_button(label_text,label,n,v,c) then
3401   - [ "<label for=\"",label,"\">",label_text,"</label>",
3402   - "<input type=radio name=o",n," id=",label," value=\"",v,"\"",(if c then " checked" else ""),">"],
3403   - check_box(label_text, label,n,c) then
3404   - [ "<label for=\"",label,"\">",label_text,"</label>",
3405   - "<input type=checkbox name=o",n," id=\"",label,"\""+(if c then " checked " else ""),">"]
3406   - div(options, e) then
3407   - format(cinfo,sn,ic_v,any_div(options, e),format_element,is_https),
3408   - div_empty(options) then
3409   - format(cinfo,sn,ic_v,any_div_empty(options),format_element,is_https),
3410   - hidden(name, value) then
3411   - ["<input type=hidden name=o",name," value=\"",value,"\">"],
3412   -
3413   - }.
3414   -
3415   -
3416   -
3417   -
3418   -
3419   -
3420   - *** [5.9] Formating 'off form' elements.
3421   -
3422   - The encryption type 'multipart/form-data' is required for a form containing an upload.
3423   -
3424   -
3425   -define Bool
3426   - contains_an_upload
3427   - (
3428   - HTML_In_Form form_content
3429   - ).
3430   -
3431   -define Bool
3432   - contains_an_upload
3433   - (
3434   - HTML_Row(HTML_In_Form) row
3435   - ) =
3436   - mapor(contains_an_upload,
3437   - map(content,cells(row))).
3438   -
3439   -
3440   -define Bool
3441   - contains_an_upload
3442   - (
3443   - HTML_In_Form form_content
3444   - ) =
3445   - if form_content is
3446   - {
3447   - literal_pt(t) then false,
3448   - literal(t) then false,
3449   - sequence(l) then mapor(contains_an_upload,l)
3450   - text(o,t) then false,
3451   - preformated(o,s) then false,
3452   - paragraph(o,t) then false,
3453   - image(u) then false,
3454   - image(u,w,h) then false,
3455   - table(o,rows) then mapor(contains_an_upload,rows),
3456   - center(e) then contains_an_upload(e),
3457   - mail_to(m,e) then false, // 'e' may but should not contain an upload
3458   - scroller(w,h,cw,ch,e) then contains_an_upload(e),
3459   - actioner(c,t,a,an,eo,ja) then false,
3460   - foreign_link(o,u,n) then false,
3461   - private_download(p,n,e,a) then false,
3462   - text_input(lt,l,n,i,w) then false,
3463   - password_input(lt,l,n,w) then false,
3464   - text_area(o,n,i,w,h) then false,
3465   - file_upload(n,w) then true,
3466   - selector(n,s,c) then false,
3467   - selector(n,s,c,p) then false,
3468   - selector_c(n,s,c) then false,
3469   - selector_c(n,s,c,p) then false,
3470   - radio_button(_,_,n,v,c) then false,
3471   - check_box(_,_,n,c) then false,
3472   - div(o,c) then false,
3473   - div_empty(o) then false,
3474   - hidden(_,_) then false
3475   - }.
3476   -
3477   -define String
3478   - enctype
3479   - (
3480   - HTML_In_Form form_content
3481   - ) =
3482   - if contains_an_upload(form_content)
3483   - then " enctype=multipart/form-data"
3484   - else "".
3485   -
3486   -
3487   -
3488   -define Printable_tree
3489   - format
3490   - (
3491   - CommonInfo cinfo,
3492   - String sn, // state_name
3493   - Var(Int32) ic_v, // 'idnum' counter variable
3494   - HTML_Off_Form element,
3495   - Bool is_https,
3496   - ) =
3497   - if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
3498   - with format_element = (HTML_Off_Form e) |-> format(cinfo,sn,ic_v,e,is_https),
3499   - if element is
3500   - {
3501   - literal_pt(t) then t,
3502   - literal(t) then [t],
3503   - sequence(l) then flat(map(format_element,l)),
3504   - text(opts,t) then
3505   - format(cinfo,sn,ic_v,any_text(opts,t),format_element,is_https),
3506   - preformated(o,s) then
3507   - format(cinfo,sn,ic_v,any_preformated(o,s),format_element,is_https),
3508   - paragraph(opts,t) then
3509   - format(cinfo,sn,ic_v,any_paragraph(opts,t),format_element,is_https),
3510   - image(url) then
3511   - format(cinfo,sn,ic_v,any_image(url),format_element,is_https),
3512   - image(url,w,h) then
3513   - format(cinfo,sn,ic_v,any_image(url,w,h),format_element,is_https),
3514   - table(opts,rows) then
3515   - format(cinfo,sn,ic_v,any_table(opts,rows),format_element,is_https),
3516   - center(e) then
3517   - format(cinfo,sn,ic_v,any_center(e),format_element,is_https),
3518   - mail_to(a,e) then
3519   - format(cinfo,sn,ic_v,any_mail_to(a,e),format_element,is_https),
3520   - scroller(w,h,cw,ch,c) then
3521   - format(cinfo,sn,ic_v,any_scroller(w,h,cw,ch,c),format_element,is_https),
3522   - fixed_size(w,h,c) then
3523   - format(cinfo,sn,ic_v,any_fixed_size(w,h,c),format_element,is_https),
3524   - fixed_size_2(w,h,fn) then
3525   - format(cinfo,sn,ic_v,any_fixed_size_2(w,h,fn),format_element,is_https),
3526   - actioner(c,t,a,an,eo,ja) then
3527   - format(cinfo,sn,ic_v,any_actioner(c,t,a,an,eo,ja,failure),format_element,is_https),
3528   - actioner(c,t,a,an,eo,ja,fn) then
3529   - format(cinfo,sn,ic_v,any_actioner(c,t,a,an,eo,ja,success(fn)),format_element,is_https),
3530   - foreign_link(options,url,name) then
3531   - format(cinfo,sn,ic_v,any_foreign_link(options,url,name),format_element,is_https),
3532   - private_download(url,name,extra,action) then
3533   - format(cinfo,sn,ic_v,any_private_download(url,name,extra,action),format_element,is_https),
3534   - label(n) then ["<a name=\"",n,"\">"],
3535   - form(fn,attributs, c) then
3536   - [
3537   - "<form name=\"f",fn,"\"",
3538   - format(cinfo,sn,ic_v,any_coreattrs(attributs),format_element,is_https),
3539   - " method=POST",
3540   - enctype(c),
3541   - " action=\"http",
3542   - if is_https then "s" else "",
3543   - "://",common_name,":",http_port,"/\">",
3544   - // action is set dynamically by
3545   - // the actioner using JavaScript
3546   - format(cinfo,fn,sn,ic_v,c,is_https),
3547   - "</form>"
3548   - ]
3549   - div(options, e) then
3550   - format(cinfo,sn,ic_v,any_div(options, e),format_element,is_https),
3551   - div_empty(options) then
3552   - format(cinfo,sn,ic_v,any_div_empty(options),format_element,is_https),
3553   -
3554   - }.
3555   -
3556   -
3557   -
3558   -
3559   - *** [5.10] Formating meta-tags.
3560   -
3561   -define Printable_tree
3562   - format_keywords
3563   - (
3564   - List(String) l
3565   - ) =
3566   - if l is
3567   - {
3568   - [] then [ ],
3569   - [h . t] then if t is []
3570   - then [h]
3571   - else [h , ", " . format_keywords(t)]
3572   - }.
3573   -
3574   -
3575   -define Printable_tree
3576   - format
3577   - (
3578   - CommonInfo cinfo,
3579   - String state_name,
3580   - HTML_Meta m,
3581   - Bool is_https
3582   - ) =
3583   - if m is
3584   - {
3585   - keywords(l) then ["<meta name=\"keywords\" content=\"",format_keywords(l),"\">"],
3586   - refresh(co,ta,an,delay) then
3587   - ["<meta http-equiv=\"Refresh\" content=\"",delay,"; URL=",
3588   - make_actioner_url(cinfo,co,ta,state_name,an,[],is_https),"\">"],
3589   - meta(n,c) then ["<meta name=\"",n,"\" content=\"",c,"\">"],
3590   - http_equiv(n,c) then ["<meta http-equiv=\"",n,"\" content=\"",c,"\">"],
3591   - generic_meta(l) then ["<meta ",
3592   - flat(map(((String,String) p) |-> if p is (n,v) then [n,"=\"",v,"\" "],
3593   - l)),
3594   - ">"],
3595   - literal(s) then [s]
3596   - }.
3597   -
3598   -
3599   -define Printable_tree
3600   - format
3601   - (
3602   - CommonInfo cinfo,
3603   - String state_name,
3604   - List(HTML_Meta) metas,
3605   - Bool is_https,
3606   - String charset
3607   - ) =
3608   - if metas is
3609   - {
3610   - [] then [format(cinfo,state_name,http_equiv("content-type",
3611   - "text/html; charset="+charset),is_https)],
3612   - [h . t] then [format(cinfo,state_name,h,is_https)
3613   - . format(cinfo,state_name,t,is_https,charset)]
3614   - }.
3615   -
3616   -
3617   -define Printable_tree
3618   - format
3619   - (
3620   - Body_Option o
3621   - ) =
3622   - if o is
3623   - {
3624   - background_color(c) then [" bgcolor=\"" , (String)html_format(c), "\""],
3625   - background_image(n) then [" background=", n],
3626   - background_image(n,o) then [" style=\"background: url(",n,")",format(o),"\""]
3627   -
3628   - }.
3629   -
3630   -
3631   -
3632   -define Printable_tree
3633   - format
3634   - (
3635   - List(Body_Option) l
3636   - ) =
3637   - if l is
3638   - {
3639   - [ ] then [ ],
3640   - [h . t] then [format(h) . format(t)]
3641   - }.
3642   -
3643   -define Printable_tree
3644   - add_css_files
3645   - (
3646   - List(CSS_File) l
3647   - ) =
3648   - if l is
3649   - {
3650   - [ ] then [ ],
3651   - [h . t] then
3652   - [ ["<LINK rel=\"stylesheet\" type=\"text/css\" href=" + file_name(h) + ">\n" ]
3653   - . add_css_files(t)]
3654   - }.
3655   -
3656   -define Printable_tree
3657   - add_css_styles
3658   - (
3659   - List(CSS_Style) css_styles
3660   - ) =
3661   -
3662   - if css_styles is
3663   - {
3664   - [] then [],
3665   - [_._] then [ "<style type=\"text/css\"><!--\n",
3666   - format_css_styles(css_styles),
3667   - " --></style>"
3668   - ]
3669   - }.
3670   -
3671   -define Printable_tree
3672   - format
3673   - (
3674   - CommonInfo cinfo,
3675   - String state_name,
3676   - HTML_Page page,
3677   - Bool is_https,
3678   - String charset
3679   - ) =
3680   - if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
3681   - with ic_v = var((Int32)0),
3682   - if page is
3683   - {
3684   - html_page(title,metas,css_styles, css_files, body) then
3685   - if body is body(options,element) then
3686   - [ doctype_w3c_header,
3687   - "<html>",
3688   - "<head>",
3689   - add_css_styles(css_styles),
3690   - add_css_files(css_files),
3691   - "<link rel=\"shortcut icon\" href=\"favicon.ico\">",
3692   - "<script type = \"text/javascript\" language=\"JavaScript\">",
3693   - " function show_local_popup(divname,stvname) {",
3694   - " if (document.layers) { var d = eval(document.divname); } else\n",
3695   - " if (document.getElementById) { var d = eval(\"document.getElementById(divname)\"); } else\n",
3696   - " if (document.all) { var d = eval(document.all.divname.style)};\n",
3697   - // " alert(typeof(eval(stvname))); ",
3698   - " var s = eval(stvname); ",
3699   - " if (s[0]==0) ",
3700   - " { s[0]=1; d.style.visibility = 'visible'; d.zIndex = 100; } else\n",
3701   - " { s[0]=0; d.style.visibility = 'hidden'; }; }",
3702   - "</script>",
3703   - "<title>",title,"</title>", // put title
3704   - format(cinfo,state_name,metas,is_https,charset), // format the metas
3705   - "</head>",
3706   - "<body ", format(options), ">", // format body options
3707   - //"<center>",
3708   - format(cinfo,state_name,ic_v,element,is_https),
3709   - //"</center>",
3710   - "</body>",
3711   - "</html>"
3712   - ]
3713   - }.
3714   -
3715   -
3716   -
3717   -
3718   -
3719   -
  1 +
  2 +
  3 + *Project* Anubis
  4 +
  5 + *Title* Making interactive Web sites.
  6 +
  7 + *Copyright* Copyright (c) Alain Prouté 2004-2005.
  8 +
  9 +
  10 + *Author* Alain Prouté
  11 +
  12 + *Revised* January 2005.
  13 +
  14 +
  15 + *Overview*
  16 +
  17 + In this file we propose simple tools for making well structured interactive and secured
  18 + web sites.
  19 +
  20 +
  21 + ----------------------------------- Table of Contents ---------------------------------
  22 +
  23 + * (1) Structure of a web site.
  24 + ** (1.1) Three sorts of data.
  25 + ** (1.2) How requests are handled.
  26 + ** (1.3) What web pages are made of.
  27 + ** (1.4) Actions.
  28 + ** (1.5) States.
  29 +
  30 + * (2) Carrying on.
  31 + ** (2.1) Describing your web sites.
  32 + ** (2.2) Directories on the server's disk.
  33 + ** (2.3) Starting your web sites.
  34 +
  35 + * (3) The HTML interface.
  36 + ** (3.1) Types used by the HTML interface.
  37 + ** (3.2) ``in form'' versus ``off form''.
  38 + ** (3.3) Defining your own style.
  39 + ** (3.4) Actioners and forms.
  40 + ** (3.5) Local popup.
  41 +
  42 + ---------------------------------------------------------------------------------------
  43 +
  44 +
  45 +read tools/basis.anubis
  46 +read CXM_common.anubis
  47 +read CXM_multihost_http_server.anubis
  48 +read CXM_mime.anubis
  49 +
  50 +
  51 +
  52 + * (1) Structure of a web site.
  53 +
  54 + First of all we need to explain what a web site should be made of. Ideally, the
  55 + visitor (also called the 'client') should see the web site working as any other
  56 + interactive computer software. So, it should be clear that a 'session' (i.e. a visit
  57 + to the web site, including the consultation of several pages) is some kind of
  58 + conversation between the visitor and the web site, and that the web site should
  59 + maintain a 'current state' of this conversation. At each new request (click) from the
  60 + visitor, this state must be updated. This whole conversation is called a 'session' and
  61 + should not be confused with a single request.
  62 +
  63 +
  64 +
  65 + ** (1.1) Three sorts of data.
  66 +
  67 + All the data needed for putting a web site at work may be dispatched into three
  68 + categories:
  69 +
  70 + 1. Constant data (data that never change). These data may be hard coded into the
  71 + Anubis source files of the web site.
  72 +
  73 + 2. Permanent data (data which always exist independantly of the users connected to
  74 + the web site). These data are normally recorded into data bases.
  75 +
  76 + 3. Session data (data which depend on a particular visitor and which exist only
  77 + during the time he visits the web site). These data are stored into so-called
  78 + 'states'.
  79 +
  80 +
  81 + It is important to determine which data belongs to which category. This is part of your
  82 + design decisions.
  83 +
  84 +
  85 +
  86 + ** (1.2) How requests are handled.
  87 +
  88 + We want to separate the following two functionalities (which are used at each request
  89 + (click) during a single session):
  90 +
  91 + - computing the new state from the previous state and from the client request, and
  92 + updating the data base,
  93 +
  94 + - computing the page to be sent to the client from the new current state and from
  95 + the informations in the data base.
  96 +
  97 +
  98 + The next picture shows the structure we have in mind:
  99 +
  100 +
  101 + request +---------+ HTML page (with a hidden state name)
  102 + .-------------------| client |<--------------.
  103 + | .-----------------| | |
  104 + | | previous state +---------+ |
  105 + | | name (if any) |
  106 + | | | client side
  107 + ............................................................................
  108 + | | | server side
  109 + | | |
  110 + | | .-------------------. |
  111 + | | | previous state | |
  112 + V V V | |
  113 + +---------------+ +---------------+ +--------------+
  114 + | compute state | | server's disk | | compute page |
  115 + +---------------+ +---------------+ +--------------+
  116 + ^ | | ^ ^ ^ ^ ^
  117 + | | | | | | | |
  118 + | | `--------------------+--------------------' | |
  119 + | | new state | | |
  120 + read | `------------------------+--------------------' |
  121 + write | new state name |
  122 + update V |
  123 + +-----------+ |
  124 + | data base |--------------------------------------------'
  125 + +-----------+ read only
  126 +
  127 +
  128 + When the client begins a session, there is no previous state. In this case, a default
  129 + 'initial state' is used instead.
  130 +
  131 + The data base may be updated by 'compute state' box, but should not be update by the
  132 + 'compute page' box. The 'compute page' box should be allowed only to read the data
  133 + base.
  134 +
  135 + In this file, all the above stuff is defined, except the 'compute state' and 'compute
  136 + page' boxes. You just have to provide the function for computing a new state (compute
  137 + state) and the function for computing the page (compute page) from the new state. You
  138 + don't have to worry about state names, saving and retrieving states and the like.
  139 +
  140 +
  141 +
  142 +
  143 +
  144 + ** (1.3) What web pages are made of.
  145 +
  146 + What the client can see in his browser's window may be called a 'page'. Within a page,
  147 + we have several sorts of components:
  148 +
  149 + - 'local' components, i.e. all components which do not open a connection, like
  150 + texts, images, etc... possibly using JavaScript programmation,
  151 +
  152 + - 'actioners', which, when clicked upon, open a connection with our web site; they
  153 + may appear as links or buttons, etc...
  154 +
  155 + - 'foreign links', which when clicked upon, open a connection with another web site
  156 + (or ours eventually).
  157 +
  158 + Of course, what an actioner does is just ask our web site to perform an action. To that
  159 + end, the actioner essentially sends the name of the action to be performed. However, it
  160 + may be necessary to provide additional informations which may be seen as 'operands' of
  161 + the action. In order to attach operands to an action, HTML provides the notion of
  162 + 'form'. Indeed, a form contains essentially a set of input fields into which the client
  163 + may put values for the required operands of the action, and a submit button, which is
  164 + the actioner itself. Notice that a single form may contain several submit buttons,
  165 + which simply means that there are several distincts actions taking the same set of
  166 + operands.
  167 +
  168 + Restrictions must be put on the use of all theses gadgets. Indeed, for example,
  169 + putting a form within another form is officially meaningless in HTML, and the client's
  170 + browser may be seriously disturbed by this. In this file, we propose an interface to
  171 + the HTML language, which forbids such meaningless things, simply by imposing a strict
  172 + typing of HTML concepts.
  173 +
  174 + Each web site may be accessible through two communication channels:
  175 +
  176 + - a non secured channel (HTTP),
  177 + - a secured channel (HTTPS).
  178 +
  179 + Nevertheless, the whole thing should be considered as a single web site. For example,
  180 + you may have a secured page, obtained through HTTPS, containing public images obtained
  181 + through HTTP. An actioner in a non secured page may open a secured connection, and
  182 + conversely.
  183 +
  184 + Summarizing, a web page is made of local elements, foreign links and actioners.
  185 + Actioners receive operands from forms, and they also choose to communicate through the
  186 + non secured or through the secured channel.
  187 +
  188 +
  189 +
  190 + +-------------------+
  191 + | page |
  192 + | | +---------------+
  193 + | +--------------+ | | next page |
  194 + | | form | | | (non secured) |
  195 + | | +----------+ | | HTTP | |
  196 + | | | actioner |---------------------------->| |
  197 + | | +----------+ | | +---------------+
  198 + | | | |
  199 + | | +----------+ | | +---------------+
  200 + | | | actioner |---------------------------->| next page |
  201 + | | +----------+ | | HTTPS | (secured) |
  202 + | | | | | |
  203 + | +--------------+ | | |
  204 + | | +---------------+
  205 + | |
  206 + +-------------------+
  207 +
  208 +
  209 + Notice that actioners need no be necessarily put into forms. In that case, they work as
  210 + ordinary links, but they still may receive operands as we shall see.
  211 +
  212 +
  213 +
  214 +
  215 + ** (1.4) Actions.
  216 +
  217 + The client opens a new connection with our web site whenever he clicks on an
  218 + actioner. The result is that a request is sent, essentially made of a list of 'web
  219 + arguments'. Each web argument is a pair (name,value). One of these web arguments, the
  220 + 'action' web argument (whose name is "a"), determines the action to be performed. The
  221 + other web arguments (not including "s", used to identify the state) are the operands
  222 + for this action.
  223 +
  224 + Hence, the 'compute state' box in the picture above, splits naturally into as many
  225 + sub-boxes as there are actions. For this reason, we define the following type for
  226 + representing actions (where '$State' is the type representing session informations):
  227 +
  228 +public type Web_Action($SessionTicket, $State):
  229 + http_action (String name, // name of action
  230 + (Maybe($State)) -> Bool allow, // true if action allowed
  231 + (HTTP_Info http_info,
  232 + List(Web_arg) web_args, // actually only 'operands' web arguments
  233 + Maybe($State) state) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) do_it),
  234 + https_action (String name, // name of action
  235 + (Maybe($State)) -> Bool allow, // true if action allowed
  236 + (HTTP_Info http_info,
  237 + List(Web_arg) web_args, // actually only 'operands' web arguments
  238 + Maybe($State) state) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) do_it),
  239 + http_https_action (String name,
  240 + (Maybe($State)) -> Bool allow, // true if action allowed
  241 + (HTTP_Info http_info,
  242 + List(Web_arg) web_args,
  243 + Maybe($State) state) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) do_it).
  244 +
  245 + 'http_action's are executed only under HTTP, and 'https_action's are executed only
  246 + under HTTPS. 'http_https_action's may be executed under both types of connections.
  247 +
  248 + Each action has a name, which is used to identify the action. Each action also has a
  249 + function 'allow' whose job is to verify that the action is allowed in the current
  250 + state, and a function 'do_it' for performing the action. The function 'do_it' receives
  251 + a lot of informations:
  252 +
  253 + - 'HTTP informations':
  254 + - the IP address of the client,
  255 + - the URI requested by the client (after redirection),
  256 + - the list of HTTP headers generated by the client's browser,
  257 + - the list of web arguments sent by the client (except "s" and "a"),
  258 + - the previous state (or the 'initial' or 'ticket expired' state if no previous
  259 + state can be found).
  260 +
  261 + In most cases, HTTP informations are not used. This is the reason why they are gathered
  262 + for simplicity into a unique datum of type 'HTTP_Info'.
  263 +
  264 +// For your convenience, we introduce the following simpler variants:
  265 +//
  266 +//public define Web_Action($State)
  267 +// http_action
  268 +// (
  269 +// String name,
  270 +// $State -> Bool allow,
  271 +// (List(Web_arg),$State) -> $State do_it
  272 +// ) =
  273 +// http_action(name,
  274 +// (Maybe($State) ms) |-> if ms is
  275 +// {
  276 +// failure then true,
  277 +// success(s) then allow(s)
  278 +// },
  279 +// (HTTP_Info h, List(Web_arg) l, Maybe($State) s) |-> if s is
  280 +// {
  281 +// failure then (failure, []),
  282 +// success(s2) then (success(do_it(l,s2)), [])
  283 +// }).
  284 +//
  285 +//public define Web_Action($State)
  286 +// https_action
  287 +// (
  288 +// String name,
  289 +// $State -> Bool allow,
  290 +// (List(Web_arg),$State) -> $State do_it
  291 +// ) =
  292 +// https_action(name,
  293 +// (Maybe($State) ms) |-> if ms is
  294 +// {
  295 +// failure then true,
  296 +// success(s) then allow(s)
  297 +// },
  298 +// (HTTP_Info h, List(Web_arg) l, Maybe($State) s) |-> if s is
  299 +// {
  300 +// failure then (failure, []),
  301 +// success(s2) then (success(do_it(l,s2)), [])
  302 +// }).
  303 +//
  304 +//public define Web_Action($State)
  305 +// http_https_action
  306 +// (
  307 +// String name,
  308 +// $State -> Bool allow,
  309 +// (List(Web_arg),$State) -> $State do_it
  310 +// ) =
  311 +// http_https_action(name,
  312 +// (Maybe($State) ms) |-> if ms is
  313 +// {
  314 +// failure then true,
  315 +// success(s) then allow(s)
  316 +// },
  317 +// (HTTP_Info h, List(Web_arg) l, Maybe($State) s) |-> if s is
  318 +// {
  319 +// failure then (failure, []),
  320 +// success(s2) then (success(do_it(l,s2)), [])
  321 +// }).
  322 +
  323 +
  324 +
  325 + When you define your web site, you must provide the list of all the actions of the
  326 + site. When a new state has been computed, a graphical representation of this state
  327 + must be sent to the client. To that end, you must provide a function (named below
  328 + 'compute_page') of type:
  329 +
  330 + $State -> HTML_Page
  331 +
  332 + where the type 'HTML_Page' (defined below in this file) abstractly represents HTML
  333 + pages.
  334 +
  335 +public type HTML_Page:...
  336 +
  337 + It should be clear that states and pages are deeply linked together. Indeed, we really
  338 + understand the page shown to the client as a representation of the current state of the
  339 + conversation between the client and the web site, but also containing informations
  340 + taken from the data bases.
  341 +
  342 +
  343 +
  344 +
  345 +
  346 + ** (1.5) States.
  347 +
  348 + Now, we explain how you can define the type (say 'State') to be used as an instance of
  349 + the type parameter '$State'. The following is just a suggestion.
  350 +
  351 + Each state determines a page (since 'compute_page' computes a page from a
  352 + state). However, some components of the state may be independant of the page. It may be
  353 + the case for example for the indication of the natural language used by the
  354 + client. Hence, a state should be made of (at least) two parts:
  355 +
  356 + - informations which are the same for all pages,
  357 + - informations which are particular to each page.
  358 +
  359 + For example, you could define:
  360 +
  361 + type Page: // one alternative per page, with particular informations
  362 + login(...), // in the components
  363 + main_page(...),
  364 + ...etc...
  365 +
  366 + Now, the type 'State' could be defined as follows:
  367 +
  368 + type State:
  369 + state(Language, // informations valid for all pages
  370 + ...,
  371 + Page). // informations particular to a page
  372 +
  373 + However, if you are making a secured web site within which clients should be identified
  374 + (by id and password), it may be a good idea to have two sorts of states, one for non
  375 + identified clients and one for identified clients. In this case, define the type
  376 + 'State' as follows (this is just a suggestion):
  377 +
  378 + type State:
  379 + non_identified(Language),
  380 + identified(String id,
  381 + Language,
  382 + Page).
  383 +
  384 + When a request arrives, check if the previous state is 'identified(...)' or
  385 + 'non_identified(...)', and don't provide access to certain pages to non identified
  386 + clients. This is required for security.
  387 +
  388 + Some more words on security. If your site needs to identify clients, define the
  389 + initial state as 'non_identified(...)'. Construct a 'login' page, and check the id and
  390 + password of the client. If the id and password are correct, then change the state of
  391 + the client to 'identified(...)'. No other action should be able to do that. Now, be
  392 + confident that clients cannot forge states. The only information they have is the name
  393 + of a state, not the state itself which is never sent over the network, but only stored
  394 + on the server's disk. The name of the state is constructed using strong cryptographical
  395 + methods (sha1). If everything (since the 'login' page) is performed under HTTPS, even
  396 + state names cannot be seen by a third party. So, if the system retrieves a previous
  397 + state of the form 'identified(...)', you can be confident that your client is well
  398 + identified, and you can send him confidential informations.
  399 +
  400 + States have a limited life time. It may happen that a client clicks on a button at a
  401 + time its state is out of date. In this case, this system considers that the new state
  402 + is a special state named 'ticket expired'. You must provide a function producing this
  403 + state when you describe your web site. The page corresponding to this state must just
  404 + inform the client that he/she waited a too long time before clicking on a button, and
  405 + has to restart (a new conversation) from the begining.
  406 +
  407 +
  408 +
  409 + * (2) Carrying on.
  410 +
  411 + ** (2.1) Describing your web sites.
  412 +
  413 + Before you may start your web site, you must describe it, i.e. produce a datum of the
  414 + opaque type 'Web_Site'.
  415 +
  416 +public type Web_Site:...
  417 +
  418 + Producing such a datum may be performed by:
  419 +
  420 +public define Web_Site
  421 + make_web_site_description
  422 + (
  423 + List(String) common_names, // for example: ["www.our-business.com",
  424 + // "192.168.0.1"]
  425 + // the second one is just for testing
  426 + String site_directory, // where 'public' and other directories are
  427 + // located (should NOT end with '/')
  428 + One -> One init,
  429 + (HTTP_Info) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) initial_state,
  430 + ($State expired,
  431 + HTTP_Info,
  432 + List(Web_arg),
  433 + Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) ticket_expired_state,
  434 + (HTTP_Info,
  435 + List(Web_arg),
  436 + Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) ticket_lost_state,
  437 + List(Web_Action($SessionTicket, $State)) actions,
  438 + (Maybe($SessionTicket), Maybe($State)) -> HTML_Page compute_page,
  439 + Int32 timeout, // seconds (todo: minutes)
  440 + List(Redirection) redirections,
  441 + String charset,
  442 + List(String) journal_extensions,
  443 + List(String) journal_headers,
  444 + String authorization_secret,
  445 + List(MIME) known_mime_types,
  446 + (String action_name,
  447 + List(Web_arg) args)-> One before_send_file
  448 + ).
  449 +
  450 +
  451 + Explanations:
  452 +
  453 + 'common_names' is the list of names of the site (the name the browser must send as the
  454 + value of the 'Host' HTTP header in order to access the site must be in that list). Such
  455 + a name generally looks like this:
  456 +
  457 + www.somewhere.com
  458 +
  459 + If you are using HTTPS, you also have an 'X.509 SSL server certificate'. The name of
  460 + the site must be exactly the same as the name on the certificate (which is precisely
  461 + called the 'common name' in the X.509 jargon). If the two names do not match, the site
  462 + will still work, but the transaction will not be transparent to the client. His browser
  463 + will complain that the name of the certificate does not match the name of the site, and
  464 + he will have to accept the certificate manually.
  465 +
  466 + 'site_directory' is the absolute path to the directory where the files needed by the
  467 + site are located. Usually this directory looks like:
  468 +
  469 + my_anubis/web_sites/www.somewhere.com
  470 +
  471 + However, this information is not computed from 'common_name', so that you can change
  472 + the common name (for example temporarily, for networking reasons) without loosing
  473 + access to the files.
  474 +
  475 + 'ticket_expired_state(expired_state,http_info,lwa,is_https)' must produce the state
  476 + whose graphical representation is a page explaining to the user that its 'ticket' (or
  477 + 'session information') has expired, and that he/she must close all popup windows and
  478 + start a new session. The arguments of the function contain the previous (expired)
  479 + state and all current informations concerning the user. This arguments may be useful
  480 + for example for producing the expiration message in the language chosen by the user.
  481 + You can also (and this may be much smarter) send a 'ticket prolongation page'
  482 + (including a new login for example), and resume the same conversation, since you have
  483 + all the pertinent informations at hand. In the case the ticket is definitely lost, the
  484 + second fonction 'ticket_lost_state' is used.
  485 +
  486 + Notice that despite the fact that the parameter $State is involved in the arguments of
  487 + the above function, the type 'Web_Site' does not depend on this parameter. This allows
  488 + to produce lists of web site descriptions, where each description may be constructed
  489 + with a different instance of $State. This is required because distinct sites must have
  490 + distinct types of session informations. This is made possible by the fact that the
  491 + type is obscure, and the constructor replaced by a function which assembles
  492 + 'ticket_expired_state', ticket_lost_state', 'actions' and 'compute_page' into a single
  493 + entity not depending on $State. You should have a look to the private part of this file
  494 + if you want more precisions about this programming technique.
  495 +
  496 + 'charset' is a string which will determine the character encoding to be used by the
  497 + browser. Typically, this string is one of: "UTF-8", "ISO-8859-1", "Windows-1252",
  498 + etc...
  499 +
  500 + 'before_send_file' is a function which is executed just before the HTTP server sends a
  501 + file. It gets an action name and the web arguments received with the request for that
  502 + file. Notice that this action name and these web arguments may be put into a
  503 + 'private_download' element, and will come back to the server at the time of the
  504 + download.
  505 +
  506 +
  507 +
  508 + ** (2.2) Directories on the server's disk.
  509 +
  510 + The description of you site contains the name of the directory within which the
  511 + required files are located. This may be for example:
  512 +
  513 + my_anubis/web_sites/www.our-business.com/
  514 +
  515 + This is called the 'site directory' (for the given site). Within the site directory,
  516 + the following directories are created by this program:
  517 +
  518 + states
  519 + public
  520 + journal
  521 + private_download
  522 + upload_temporary
  523 +
  524 + The directory 'states' is used for storing states (session informations). Out of date
  525 + states are automatically removed after some time.
  526 +
  527 + The tree rooted at 'public' contains files that the server is allowed to send to the
  528 + clients. For security reasons, the server never sends a file which is not within the
  529 + tree whose root is this 'public' directory (except for the 'private download' mecanism;
  530 + see 'web/multihost_http_server.anubis'). Also, the MIME type (see 'web/mime.anubis')
  531 + must have been recognized before the file may be sent.
  532 +
  533 + The directory 'journal' contains the jounal files. The roles of the remaining
  534 + directories 'private_download' and 'upload_temporary' is explained in
  535 + 'multihost_http_server.anubis', where you will also find further informations on
  536 + 'public' and 'journal'.
  537 +
  538 +
  539 +
  540 +
  541 + ** (2.3) Web servers parameters.
  542 +
  543 + The web servers have several parameters useful for administration. They are described
  544 + as follows:
  545 +
  546 + public type WebServersParameters:
  547 + wsparms(Var(Bool) shutdown_required,
  548 +
  549 +
  550 +
  551 +
  552 + ** (2.4) Starting your web sites.
  553 +
  554 + When you have described all your web sites (you may want to have several web sites, and
  555 + they are distinguished by their 'common name'), you may start them all together using
  556 + 'start_web_sites' below. This function returns a result of the following type:
  557 +
  558 +public type Start_Web_Sites_Result:
  559 + cannot_bind_to_port(Int32),
  560 + cannot_bind_to_port(Int32,Int32),
  561 + ok(Server http_server,
  562 + Server https_server).
  563 +
  564 + Indeed, it may happen that the system cannot bind (begin to listen) to one of the two
  565 + ports (or to both). The main reason is that another server is already listening on that
  566 + port. Another reason may be that 'anbexec' has not been correctly installed, i.e. that
  567 + the 's' bit has not been set for 'user' and 'group' (there is not such problem under
  568 + Windows). Also notice that the Linux kernel may need a rather long time (up to several
  569 + minutes) before liberating a listening port. Now, if the system can bind to the two
  570 + ports, the pair of the two servers is returned. Two tools are useful for manipulating
  571 + servers:
  572 +
  573 + shutdown of type Server -> One
  574 + is_down of type Server -> Bool
  575 +
  576 + They are defined in 'predefined.anubis' (together with the type 'Server').
  577 +
  578 +
  579 +public define Start_Web_Sites_Result
  580 + start_web_sites
  581 + (
  582 + Int32 ip_address, // the IP address shared by the web sites
  583 + Int32 http_port, // usually: 80
  584 + Int32 https_port, // usually: 443
  585 + String ssl_certificate_common_name,
  586 + List(Web_Site) web_sites, // web sites to be started
  587 + Var(Bool) shutdown_required
  588 + ).
  589 +
  590 + 'ip_address' is the IP address on which the two servers listen. If you put 0, the
  591 + servers listen on all the IP addresses of the machine. This may be useful if the
  592 + machine has several network interfaces.
  593 +
  594 + 'ssl_certificate_common_name' is the common name of the SSL certificate that 'anbexec'
  595 + loads when it starts. One instance of 'anbexec' cannot handle more than one SSL server
  596 + certificate. This is due to a problem of conception of SSL itself. See the book 'SSL
  597 + and TLS' by Eric Rescorla (at Addison Wesley) for more explanations.
  598 +
  599 + Notice that the number of servers is always 2, regardless of the number of web sites
  600 + you are starting.
  601 +
  602 + The dynamic variable 'shutdown_required' may be used to control the shutdown of the two
  603 + servers from within the web site (typically the administration part). The servers will
  604 + shutdown as soon as this variable contains 'true'. So you must provide a variable
  605 + containing 'false' otherwise your servers will not run. You may also use the primitive
  606 + 'must_restart' (see 'predefined.anubis') to control the restarting of your servers.
  607 +
  608 +
  609 +
  610 +
  611 +
  612 +
  613 + * (3) The HTML interface.
  614 +
  615 + We propose an interface to dynamic HTML. Dynamic HTML includes HTML, and a combination
  616 + of CSS (Cascading Style Sheet) and JavaScript techniques for making HTML elements more
  617 + reactive and attractive on the client side.
  618 +
  619 +
  620 + ** (3.1) Types used by the HTML interface.
  621 +
  622 + For easy reference, we gather below the definitions of all the types used by the HTML
  623 + interface, and we comment them immediately.
  624 +
  625 +
  626 +public type HTML_Size:
  627 + absolute(Int32), // in pixels
  628 + percentage(Int32).
  629 +
  630 +
  631 +public type Text_Option:
  632 + size(Int32), // size of character font to use
  633 + font(String), // name of character font to use (such as "helvetica",...)
  634 + color(RGB), // color to be used for characters
  635 + italic,
  636 + oblique,
  637 + small_capitals,
  638 + bold,
  639 + underlined,
  640 + left_justified,
  641 + right_justified,
  642 + justified, // justified on both sides
  643 + line_through,
  644 + nowrap,
  645 + class(String). //CSS class
  646 +
  647 + A list of 'Text_Option' must be given with each text you want to put in your page.
  648 +
  649 + This indicate the way of reading text.
  650 +public type Reading_Way:
  651 + ltr, //the text is readable from "Left To Right" like english
  652 + rtl. //the text is readable from "Right To Left" like arabic
  653 +
  654 +
  655 +
  656 +public type CoreAttrs:
  657 + id (String),
  658 + class (String),
  659 + style (String),
  660 + title (String).
  661 +
  662 +public type I18n:
  663 + lang (String),
  664 + dir (Reading_Way).
  665 +
  666 +public type DIV_Option:
  667 + id (String),
  668 + class (String),
  669 + style (String),
  670 + title (String),
  671 + lang (String),
  672 + dir (Reading_Way).
  673 +
  674 +
  675 + A list of 'DIV_Option' must be given with each DIV you want to put in your page.
  676 +
  677 +
  678 +public type Table_Option:
  679 + background_color(RGB), // applied to all cells in the table
  680 + background_image(String url),
  681 + border(Int32 width_of_outer_edge, // if not present, all values are 0
  682 + Int32 width_of_top_of_relief,
  683 + Int32 width_of_inner_edge,
  684 + RGB border_color),
  685 + width(Int32), // sets a minimal width for the table
  686 + percentage_width(Int32).
  687 +
  688 +
  689 +public define Table_Option nude = border(0,0,0,rgb(0,0,0)).
  690 +
  691 +
  692 + A list of 'Table_Option' must be given with each table.
  693 +
  694 +
  695 +public type BackgroundOption:
  696 + repeat, // repeat the background in both directions
  697 + repeat_horizontal, // repeat the background only horizontally
  698 + repeat_vertical, // repeat the background only verticall
  699 + no_repeat, // don't repeat the background
  700 + center.
  701 +
  702 +
  703 +public type Cell_Option:
  704 + left, // put the content of the cell on the left
  705 + h_center, // center the content of the cell horizontally
  706 + right, // put the content of the cell on the right
  707 + top, // put the content of the cell upwards
  708 + v_center, // center the content of tye cell vertically,
  709 + bottom, // put the content of the cell downwards
  710 + base_line, // align the content vertically according to base lines
  711 + background_color(RGB),
  712 + background_image(String url, BackgroundOption),
  713 + width(Int32), // sets a minimal width for the cell
  714 + percentage_width(Int32),
  715 + height(Int32), // sets a minimal height for the cell
  716 + columns(Int32), // lets the cell span over several columns
  717 + rows(Int32), // lets the cell span over several rows
  718 + nowrap. // do not allow text wrapping within the cell
  719 +
  720 + A list of 'Cell_Option' must be given with each cell and each row in a table. Options
  721 + given with a row apply to all the cells in the row, but are superseded by options given
  722 + with cells, which apply only to the cell they are given with.
  723 +
  724 +
  725 +public type HTML_Cell($T):
  726 + cell(List(Cell_Option) options, $T content).
  727 +
  728 + The parameter $T is later instantiated either to 'HTML_In_Form' or to 'HTML_Off_Form',
  729 + depending on where you put your table (within a form or not within a form). For your
  730 + convenience, we define the following particular case:
  731 +
  732 +public define HTML_Cell($T)
  733 + cell
  734 + (
  735 + $T content
  736 + ) =
  737 + cell([],content).
  738 +
  739 +
  740 +
  741 +public type HTML_Row($T):
  742 + row(List(Cell_Option) options, List(HTML_Cell($T)) cells).
  743 +
  744 + Same remark as for 'HTML_Cell($T)'. We define several convenience functions:
  745 +
  746 +public define HTML_Row($T)
  747 + row
  748 + (
  749 + List(HTML_Cell($T)) cells
  750 + ) =
  751 + row([],cells).
  752 +
  753 +public define HTML_Row($T)
  754 + row
  755 + (
  756 + HTML_Cell($T) cell
  757 + ) =
  758 + row([],[cell]).
  759 +
  760 +public type Actioner_Connection:
  761 + same, // use same type of connection as current page
  762 + http, // use non secured connection
  763 + https. // use secured connection
  764 +
  765 +public type Other_Window_Option:
  766 + resizable, // the new window may be resized by the client
  767 + scrollbars, // the new window has scrollbars
  768 + width(Int32), // the new window has the specified width
  769 + height(Int32). // the new window has the specified height
  770 +
  771 +public type Actioner_Target:
  772 + same,
  773 + same (String label),
  774 + other(String window_name, List(Other_Window_Option)).
  775 +
  776 +public type Actioner_Aspect:
  777 + link (List(Text_Option),String text), // hypertext link
  778 + push_button (List(CoreAttrs),String text),
  779 + button (String url_off, String url_on), // rollover button
  780 + button (String url_off, String url_on, Int32 w, Int32 h), // idem with size
  781 + immediate_selector (String name, Int32 size, List(String) choices).
  782 +
  783 +
  784 +public type Actioner_Local_Action:
  785 + close_window.
  786 +
  787 +
  788 +public define Actioner_Aspect
  789 + link
  790 + (
  791 + String text
  792 + ) =
  793 + link([],text).
  794 +
  795 +
  796 +public define Actioner_Aspect
  797 + link
  798 + (
  799 + List(Text_Option) options,
  800 + Int32 i
  801 + ) =
  802 + link(options,integer_to_string(i)).
  803 +
  804 +public define Actioner_Aspect
  805 + link
  806 + (
  807 + Int32 i
  808 + ) =
  809 + link([],i).
  810 +
  811 +public define Actioner_Aspect
  812 + button
  813 + (
  814 + String url_img
  815 + ) =
  816 + button(url_img,url_img).
  817 +
  818 +
  819 +
  820 + Actioners are explained in details below.
  821 +
  822 +
  823 +public type TextAreaOption:
  824 + disabled,
  825 + read_only,
  826 + wrap_lines.
  827 +
  828 +public type HTML_In_Form:
  829 + literal_pt (Printable_tree),
  830 + literal (String),
  831 + sequence (List(HTML_In_Form) items),
  832 + text (List(Text_Option), String the_text),
  833 + preformated (List(Text_Option), String),
  834 + paragraph (List(Text_Option), String the_text),
  835 + image (String url),
  836 + image (String url, Int32 width, Int32 height),
  837 + table (List(Table_Option), List(HTML_Row(HTML_In_Form))),
  838 + center (HTML_In_Form),
  839 + mail_to (String email, HTML_In_Form element),
  840 + scroller (Int32 width, Int32 height,
  841 + Int32 content_width, Int32 content_height,
  842 + HTML_In_Form content),
  843 + actioner (Actioner_Connection, Actioner_Target, Actioner_Aspect,
  844 + String action_name, List((String,String)) extra_ops,
  845 + List(Actioner_Local_Action)),
  846 + foreign_link (List(Text_Option), String url, String name),
  847 + private_download (String abs_path, String name, String extra_ext,
  848 + Maybe((String,List((String,String)))) action),
  849 + text_input (String label_text, String label, String name, String init, Int32 width),
  850 + password_input (String label_text, String label, String name, Int32 width),
  851 + text_area (List(TextAreaOption), String name, String init, Int32 width, Int32 height),
  852 + file_upload (String name, Int32 width),
  853 + selector (String name, Int32 size, List(String) choices),
  854 + selector (String name, Int32 size, List(String) choices, String selected),
  855 + // List((String,String)) = List((code,name)) where :
  856 + // name appears in selector
  857 + // code is the web-arg value
  858 + selector_c (String name, Int32 size, List((String,String)) choices),
  859 + selector_c (String name, Int32 size, List((String,String)) choices, String selected),
  860 + radio_button (String label_text, String label, String name, String value, Bool checked),
  861 + check_box (String label_text, String label, String name, Bool checked),
  862 + div (List(DIV_Option), HTML_In_Form content),
  863 + div_empty (List(DIV_Option)),
  864 + hidden (String name, String value).
  865 +
  866 +
  867 + 'HTML_In_Form' defines all the elements you may put within a form. We define a
  868 + convenience function:
  869 +
  870 +public define HTML_In_Form literal(Printable_tree t) = literal_pt(t).
  871 +
  872 +public define HTML_In_Form
  873 + foreign_link
  874 + (
  875 + Int32 tsize,
  876 + String url,
  877 + String name
  878 + ) =
  879 + foreign_link([size(tsize)],url,name).
  880 +
  881 +public define HTML_In_Form
  882 + actioner
  883 + (
  884 + Actioner_Connection conn,
  885 + Actioner_Target targ,
  886 + Actioner_Aspect asp,
  887 + String action_name,
  888 + List((String,String)) extra_ops
  889 + ) =
  890 + actioner(conn,targ,asp,action_name,extra_ops,[]).
  891 +
  892 +
  893 +
  894 +public define HTML_In_Form
  895 + text_area
  896 + (
  897 + String name,
  898 + String init,
  899 + Int32 width,
  900 + Int32 height
  901 + ) =
  902 + text_area([],name,init,width,height).
  903 +
  904 +public define HTML_In_Form
  905 + table
  906 + (
  907 + List(HTML_Row(HTML_In_Form)) rows
  908 + ) =
  909 + table([],rows).
  910 +
  911 +
  912 +public define HTML_In_Form
  913 + private_download
  914 + (
  915 + String abs_path,
  916 + String name,
  917 + String extra_ext
  918 + ) =
  919 + private_download(abs_path,name,extra_ext,failure).
  920 +
  921 +public define HTML_In_Form
  922 + private_download
  923 + (
  924 + String abs_path,
  925 + String name,
  926 + String extra_ext,
  927 + String action_name,
  928 + List((String,String)) args
  929 + ) =
  930 + private_download(abs_path,name,extra_ext,success((action_name,args))).
  931 +
  932 +public define HTML_In_Form
  933 + text
  934 + (
  935 + String s
  936 + ) =
  937 + text([],s).
  938 +
  939 +
  940 +
  941 +
  942 +public type HTML_Off_Form:
  943 + literal_pt (Printable_tree),
  944 + literal (String),
  945 + sequence (List(HTML_Off_Form) items),
  946 + text (List(Text_Option), String the_text),
  947 + preformated (List(Text_Option), String),
  948 + paragraph (List(Text_Option), String the_text),
  949 + image (String url),
  950 + image (String url, Int32 width, Int32 height),
  951 + table (List(Table_Option), List(HTML_Row(HTML_Off_Form))),
  952 + center (HTML_Off_Form),
  953 + mail_to (String email, HTML_Off_Form element),
  954 + scroller (Int32 width, Int32 height,
  955 + Int32 content_width, Int32 content_height,
  956 + HTML_Off_Form content),
  957 + fixed_size (HTML_Size width, HTML_Size height, HTML_Off_Form content),
  958 + fixed_size_2 (HTML_Size width, HTML_Size height, String name_of_HTML_file),
  959 + actioner (Actioner_Connection, Actioner_Target, Actioner_Aspect,
  960 + String action_name, List((String,String)) extra_ops,
  961 + List(Actioner_Local_Action)),
  962 + actioner (Actioner_Connection, Actioner_Target, Actioner_Aspect,
  963 + String action_name, List((String,String)) extra_ops,
  964 + List(Actioner_Local_Action), String form_name),
  965 + foreign_link (List(Text_Option), String url, String name),
  966 + private_download (String abs_path, String name, String extra_ext,
  967 + Maybe((String,List((String,String)))) action),
  968 + label (String name),
  969 + form (String form_name, List(CoreAttrs), HTML_In_Form content),
  970 + div (List(DIV_Option), HTML_Off_Form content),
  971 + div_empty (List(DIV_Option)).
  972 +
  973 + 'HTML_Off_Form' defines all the elements you may put outside any form.
  974 +
  975 +
  976 +public define HTML_Off_Form literal(Printable_tree t) = literal_pt(t).
  977 +public define HTML_Off_Form fixed_size(HTML_Size width, HTML_Size height, String name_of_HTML_file)
  978 + = fixed_size_2(width,height,name_of_HTML_file).
  979 +
  980 +
  981 +public define HTML_Off_Form
  982 + foreign_link
  983 + (
  984 + Int32 tsize,
  985 + String url,
  986 + String name
  987 + ) =
  988 + foreign_link([size(tsize)],url,name).
  989 +
  990 +
  991 +public define HTML_Off_Form
  992 + actioner
  993 + (
  994 + Actioner_Connection conn,
  995 + Actioner_Target targ,
  996 + Actioner_Aspect asp,
  997 + String action_name,
  998 + List((String,String)) extra_ops
  999 + ) =
  1000 + actioner(conn,targ,asp,action_name,extra_ops,[]).
  1001 +
  1002 +public define HTML_Off_Form
  1003 + table
  1004 + (
  1005 + List(HTML_Row(HTML_Off_Form)) rows
  1006 + ) =
  1007 + table([],rows).
  1008 +
  1009 +
  1010 +
  1011 + We add two convenience functions for 'row'. The reason why we add two functions, one
  1012 + for 'HTML_In_Form' and one for 'HTML_Off_Form', is that adding a schema with an
  1013 + arbitrary '$T' creates too many ambiguities. This is due to the fact that, if we do so,
  1014 + the arguments of the function do not refer to any of the types defined here.
  1015 +
  1016 +public define HTML_Row(HTML_In_Form)
  1017 + row
  1018 + (
  1019 + HTML_In_Form content
  1020 + ) =
  1021 + row([],[cell([],content)]).
  1022 +
  1023 +public define HTML_Row(HTML_Off_Form)
  1024 + row
  1025 + (
  1026 + HTML_Off_Form content
  1027 + ) =
  1028 + row([],[cell([],content)]).
  1029 +
  1030 +
  1031 +public define HTML_Off_Form
  1032 + private_download
  1033 + (
  1034 + String abs_path,
  1035 + String name,
  1036 + String extra_ext
  1037 + ) =
  1038 + private_download(abs_path,name,extra_ext,failure).
  1039 +
  1040 +
  1041 +public define HTML_Off_Form
  1042 + private_download
  1043 + (
  1044 + String abs_path,
  1045 + String name,
  1046 + String extra_ext,
  1047 + String action_name,
  1048 + List((String,String)) args
  1049 + ) =
  1050 + private_download(abs_path,name,extra_ext,success((action_name,args))).
  1051 +
  1052 +public define HTML_Off_Form
  1053 + text
  1054 + (
  1055 + List(Text_Option) lto,
  1056 + Int32 i
  1057 + ) =
  1058 + text(lto,integer_to_string(i)).
  1059 +
  1060 +
  1061 +public define HTML_Off_Form
  1062 + text
  1063 + (
  1064 + Int32 i
  1065 + ) =
  1066 + text([],i).
  1067 +
  1068 +public define HTML_Off_Form
  1069 + text
  1070 + (
  1071 + String s
  1072 + ) =
  1073 + text([],s).
  1074 +
  1075 + - Cell a gap between two other cells :
  1076 +
  1077 +public define HTML_Cell(HTML_Off_Form)
  1078 + width_gap
  1079 + (
  1080 + Int32 w
  1081 + ) =
  1082 + cell([width(w)],text([],"")).
  1083 +
  1084 +public define HTML_Cell(HTML_In_Form)
  1085 + width_gap
  1086 + (
  1087 + Int32 w
  1088 + ) =
  1089 + cell([width(w)],text([],"")).
  1090 +
  1091 +
  1092 + - Row a gap between two other rows :
  1093 +
  1094 +public define HTML_Row(HTML_Off_Form)
  1095 + height_gap
  1096 + (
  1097 + Int32 h
  1098 + ) =
  1099 + row([],[cell([height(h)],text([],""))]).
  1100 +
  1101 +public define HTML_Row(HTML_In_Form)
  1102 + height_gap
  1103 + (
  1104 + Int32 h
  1105 + ) =
  1106 + row([],[cell([height(h)],text([],""))]).
  1107 +
  1108 +
  1109 + Notice that the two types have alternatives in common (same name, same arguments types,
  1110 + up to the value of the parameter $T), which correspond to elements which may be put
  1111 + anywhere in the page.
  1112 +
  1113 +
  1114 +
  1115 +public type CSS_Style:
  1116 + text_options(List(Text_Option)).
  1117 +
  1118 +public type CSS_File:
  1119 + css_file(String file_name).
  1120 +
  1121 +define String
  1122 + format
  1123 + (
  1124 + List(Text_Option) l
  1125 + ).
  1126 +
  1127 +
  1128 +
  1129 +
  1130 +define Printable_tree
  1131 + format_css_styles
  1132 + (
  1133 + List(CSS_Style) l
  1134 + ) =
  1135 + if l is
  1136 + {
  1137 + [ ] then [ ],
  1138 + [h . t] then
  1139 + [ if h is
  1140 + {
  1141 + text_options(tos) then
  1142 + [" body, span, p { ", format(tos), " }\n" ]
  1143 + }
  1144 + . format_css_styles(t)]
  1145 + }.
  1146 +
  1147 +
  1148 +
  1149 +public type HTML_Meta:
  1150 + keywords (List(String)),
  1151 + refresh (Actioner_Connection connection,
  1152 + Actioner_Target target,
  1153 + String action_name,
  1154 + Int32 delay), // in seconds
  1155 + meta (String name, String content),
  1156 + http_equiv (String name, String content),
  1157 + generic_meta (List((String,String))),
  1158 + literal (String).
  1159 +
  1160 + Meta tags are put in the 'head' of the HTML page.
  1161 +
  1162 +
  1163 +public type Body_Option:
  1164 + background_color (RGB),
  1165 + background_image (String url),
  1166 + background_image (String url, List(BackgroundOption)).
  1167 +
  1168 +public type HTML_Body:
  1169 + body(List(Body_Option) options, HTML_Off_Form content).
  1170 +
  1171 +
  1172 +public type HTML_Page:
  1173 + html_page(String title,
  1174 + List(HTML_Meta) meta_tags,
  1175 + List(CSS_Style) styles,
  1176 + List(CSS_File) css_files,
  1177 + HTML_Body body).
  1178 +
  1179 +public define HTML_Page
  1180 + html_page
  1181 + (
  1182 + String title,
  1183 + List(HTML_Meta) metas,
  1184 + HTML_Body body
  1185 + ) =
  1186 + html_page(title,metas,[],[],body).
  1187 +
  1188 +public define HTML_Page
  1189 + html_page
  1190 + (
  1191 + String title,
  1192 + List(HTML_Meta) metas,
  1193 + List(CSS_Style) styles,
  1194 + HTML_Body body
  1195 + ) =
  1196 + html_page(title, metas, styles, [], body).
  1197 +
  1198 + 'HTML_Page' represents the final product of the construction of a web page.
  1199 +
  1200 +
  1201 +
  1202 +
  1203 + *** (3.2) ``in form'' versus ``off form''.
  1204 +
  1205 + There is a variety of HTML elements: texts, buttons, links, forms, inputs, etc... Some
  1206 + of them may have a content, which is yet another HTML element (or several). Hence, it
  1207 + is meaningful to say that an element is 'within' another one. Now, putting any element
  1208 + within any other one may be meaningless. For example, an input element must be put
  1209 + within a form (otherwise, it is useless), and a from within another form has no precise
  1210 + meaning (and is forbidden by the HTML specification).
  1211 +
  1212 + Actually, the main criterium is ``within a form or not within a form''. So, HTML
  1213 + elements in a given page are separated into two categories: those who are within a
  1214 + form, and the others. Nevertheless, there are elements which may belong to both
  1215 + categories, like images and texts. We want to make use of the strong typing mecanism of
  1216 + Anubis in order to forbid non meaningful placement of elements.
  1217 +
  1218 + The type 'HTML_In_Form' defines elements to be put within forms. Similarly,
  1219 + 'HTML_Off_Form' defines elements not to be put within forms. Both types are recursive,
  1220 + and 'HTML_Off_Form' refers to 'HTML_In_Form' (via the 'form' alternative, of course),
  1221 + but the two types are not cross recursive. This is the reason why it is impossible to
  1222 + put a form within a form. In order to construct a web page, you essentially have to
  1223 + produce a datum of type 'HTML_Off_Form' (maybe containing data of type 'HTML_In_Form').
  1224 +
  1225 + In practice, you don't have to worry so much about these two types, because elements
  1226 + which may be put anywhere are constructed for both types by functions with the same
  1227 + name and the same arguments. Hence, for both types, you just write the same thing. You
  1228 + are warned by the compiler only when you try to put an element at a place it is not
  1229 + allowed.
  1230 +
  1231 +
  1232 +
  1233 + *** (3.3) Defining your own style.
  1234 +
  1235 + We provide generic tools for constructing HTML elements. However, your web site needs
  1236 + to have a ``style''.
  1237 +
  1238 + To that end, you need to write down a set of ``styling functions'', using the tools
  1239 + defined here. These styling functions allow the introduction of your colors and other
  1240 + visual characteristics into the constructed elements once and for all. For example, you
  1241 + may want all your texts to be rendered in the ``Helvetica'' font, in size 14 and using
  1242 + some 'text_color'. You may write something like this:
  1243 +
  1244 + define RGB text_color = rgb(10,40,40).
  1245 +
  1246 + define HTML_Off_Form
  1247 + text
  1248 + (
  1249 + String the_text
  1250 + ) =
  1251 + text([font("helvetica"),size(14),color(text_color)],
  1252 + the_text).
  1253 +
  1254 + (and the same one for type 'HTML_In_Form') so that in order to put a piece of text in a
  1255 + page, you just write:
  1256 +
  1257 + text("... some text ...")
  1258 +
  1259 + and you don't have to provide the font, size and color for each text. If you want to
  1260 + have several styles of text presentation, you just write several sets of such
  1261 + convenience functions. This also suggests a trick. You may want for example different
  1262 + colors for 'in form' texts and 'off form' texts. This may be achieved automatically by
  1263 + defining two functions as above, with the same name and same argument type, but
  1264 + returning either a 'HTML_In_Form' or a 'HTML_Off_Form'.
  1265 +
  1266 + If this preliminary work is well done, you will not waste your time later when you
  1267 + concentrate on the actual informational content of your pages.
  1268 +
  1269 + This general principle should be applied to all sorts of elements. This is the best
  1270 + thing to do in order to separate the functions defining the visual style from the
  1271 + functions defining the informational content itself, so that changing the style without
  1272 + changing the content becomes easy. This is also the best way for having a clean and
  1273 + easily readable source for your web site.
  1274 +
  1275 +
  1276 +
  1277 +
  1278 +
  1279 + *** (3.4) Actioners and forms.
  1280 +
  1281 + We have gathered several notions from HTML into that of an 'actioner'. An actioner is
  1282 + an HTML element which opens a connection to our server when clicked upon. Actioners may
  1283 + have different visual aspects. They may look like hypertext links or like buttons
  1284 + (rollovers), or even like selectors (with immediate action). In any case, their
  1285 + behavior is the same: they open a connection to our server, and send a set of 'web
  1286 + arguments', i.e. pairs 'name=value'. Among these web arguments, one of them denotes
  1287 + the action to be performed, and the others should be considered as operands for this
  1288 + action. Actually, the precise behavior of the actioner has several variants.
  1289 +
  1290 + The connection with the server may be secured (HTTPS) or non secured (HTTP). See the
  1291 + type 'Actioner_Connection' above.
  1292 +
  1293 + You must also choose where the answer must be rendered. This may be in the same window
  1294 + or in another window (or frame). If it is in another window, the name of that window
  1295 + must be given. If the window does not exist, the browser will create it. Optionally,
  1296 + you may give the dimensions of the new window and other characteristics. See the type
  1297 + 'Actioner_Target' above.
  1298 +
  1299 + The actioner also has a visual aspect. See the type 'Actioner_Aspect' above. In the
  1300 + case of a rollover button, you provide the URLs of two images (of the same size)
  1301 + representing the button:
  1302 +
  1303 + url_off: to be used when the mouse is not over the button,
  1304 + url_on: to be used when the mouse is over the button.
  1305 +
  1306 + You can also create rollover buttons without creating images. Just use the second
  1307 + alternative named 'button'. The server creates the images automatically.
  1308 +
  1309 + The purpose of forms is just to give operands to actioners. If the actioner is placed
  1310 + within a form, all the input elements which are within this form provide operands to
  1311 + the actioner (except sometimes when they are not set by the client). If it is not put
  1312 + within a form, the actioner gets no operand, except if the name of a form is explicitly
  1313 + given, in which case the actioner gets all the inputs from that form as
  1314 + operands. Furthermore, you may want to give extra operands to the actioner. This may be
  1315 + useful for separating families of actioners with the same action name. Extra operands
  1316 + 'name=value' must be given in the form of pairs '(name,value)'.
  1317 +
  1318 + Notice that the name of a form may be used by an actioner which is off the form, so as
  1319 + to get the operands provided by this form. Also notice that several actioners may refer
  1320 + to the same form, being either in the form, or referring to the form from the
  1321 + outside. These actioners simply get the same set of operands, even if they correspond
  1322 + to distinct actions.
  1323 +
  1324 + Input elements may be put only within a form.
  1325 +
  1326 +
  1327 +
  1328 + *** (3.5) Local popup.
  1329 +
  1330 + This element looks like a link or a rollover button. When this button is clicked upon,
  1331 + a 'popup window' appears. Actually, this popup window is just a layer in the same HTML
  1332 + page, which becomes suddenly visible. It is realized with a '<div>' HTML tag. In
  1333 + particular, clicking on the button does not open any connection. This is why it is
  1334 + called 'local'. The arguments have the following roles:
  1335 +
  1336 + Actioner_Aspect aspect of the button (same semantics as for actioners)
  1337 + content content of the popup window
  1338 + x, y, position of the popup window on the HTML page (not relative
  1339 + to the button but to the page itself)
  1340 + title title of the popup window
  1341 + color color of the title bar and close button in the popup window.
  1342 + A lightened version of this color is used for the background
  1343 + of the popup window.
  1344 + width width of the title bar
  1345 +
  1346 +
  1347 +
  1348 +
  1349 +
  1350 + --- That's all for the public part ! --------------------------------------------------
  1351 +
  1352 +
  1353 +
  1354 +
  1355 +
  1356 + ----------------------------------- Table of Contents ---------------------------------
  1357 +
  1358 + *** [1] States.
  1359 + *** [1.1] Saving and retrieving states.
  1360 + *** [1.2] Deleting out of date states.
  1361 +
  1362 + *** [2] Tools.
  1363 + *** [2.1] Directories.
  1364 + *** [2.2] Secondary documents.
  1365 +
  1366 + *** [3] Managing web arguments.
  1367 + *** [3.1] Prefixing web arguments names.
  1368 + *** [3.2] Separating web arguments.
  1369 + *** [3.3] Applying an action.
  1370 +
  1371 + *** [4] Web site descriptions and the 'awp handlers'.
  1372 + *** [4.1] The type 'Web_Site'.
  1373 + *** [4.2] Making a web site description.
  1374 + *** [4.3] Starting the servers.
  1375 +
  1376 + *** [5] HTML Formating.
  1377 + *** [5.1] The type 'HTML_Any($T)'.
  1378 + *** [5.2] Formating a color.
  1379 + *** [5.3] Creating buttons.
  1380 + *** [5.4] Formating an actioner.
  1381 + *** [5.5] Formating a private download link.
  1382 + *** [5.6] Formating rows and cells in a table.
  1383 + *** [5.7] Formating elements which may be put anywhere.
  1384 + *** [5.8] Formating 'in form' elements.
  1385 + *** [5.9] Formating 'off form' elements.
  1386 + *** [5.10] Formating meta-tags.
  1387 +
  1388 + ---------------------------------------------------------------------------------------
  1389 +
  1390 +
  1391 +
  1392 +
  1393 +public define String
  1394 + doctype_w3c_header
  1395 + =
  1396 + "<!DOCTYPE HTML PUBLIC \"-//W3C//DTD HTML 4.0 Transitional//EN\" "+
  1397 + "\"http://www.w3c.org/TR/html4/loose.dtd\">\n".
  1398 +
  1399 +
  1400 +
  1401 +
  1402 + *** [1] States.
  1403 +
  1404 + We have to define functions for saving a state, retrieving a state, deleting out of
  1405 + date states. We need one such function per web site. The types of the first two
  1406 + functions depend on the parameter $State. This is not the case of the third one. The
  1407 + fact that the instance of $State is variable from one web sites to the other implies
  1408 + rather subtle manipulations using full functionality.
  1409 +
  1410 +
  1411 + *** [1.1] Saving and retrieving states.
  1412 +
  1413 + Each state is saved into a file on the server's disk (in the directory represented by
  1414 + the symbol 'state_directory', which is 'my_anubis/web_sites/common_name/states'). The
  1415 + state is saved together with a time stamp whose value is obtained by adding the current
  1416 + time to the given timeout for states. The state receives a name obtained by hashing
  1417 + (using sha1) the content of the file itself, and then encoding the hash with
  1418 + 'web_arg_encode'. The name of the file into which the state is saved is the
  1419 + concatenation of "s" and the name of the state.
  1420 +
  1421 +read CXM_web_arg_encode.anubis
  1422 +
  1423 + The tool below constructs the function which is able to save a state on the server's
  1424 + disk.
  1425 +
  1426 +define (Maybe($State) s) -> String // the function constructed returns the name of the state
  1427 + make_save_state_function
  1428 + (
  1429 + Int32 timeout,
  1430 + String state_directory
  1431 + ) =
  1432 + (Maybe($State) mbs) |->
  1433 + if mbs is
  1434 + {
  1435 + failure then "",
  1436 + success(s) then
  1437 + with time_stamp = now+timeout,
  1438 + to_be_saved = (time_stamp,s),
  1439 + state_name = web_arg_encode(sha1(s)),
  1440 + if save(to_be_saved,state_directory+"/s"+state_name) is ok
  1441 + then state_name
  1442 + else (print("Cannot create state file in '"+state_directory+"'.\n"); "")
  1443 + }.
  1444 +
  1445 +
  1446 + When a request arrives, we need to retrieve the previous state from the server's
  1447 + disk. We receive the name of that state. If the state is out of date, the state file is
  1448 + kept 3 days, and then deleted.
  1449 +
  1450 +type PreviousState($State):
  1451 + not_found, // cannot retrieve the previous state
  1452 + out_of_date($State), // the previous state is out of date
  1453 + still_valid($State). // the previous state is still valid
  1454 +
  1455 +define (String state_name) -> PreviousState($State)
  1456 + make_retrieve_state_function
  1457 + (
  1458 + String state_directory
  1459 + ) =
  1460 + (String state_name) |->
  1461 + with file_path = state_directory+"/s"+state_name,
  1462 + if (RetrieveResult((Int32,$State)))retrieve(file_path) is ok(d)
  1463 + then (
  1464 + if d is (time_stamp,s) then
  1465 + if time_stamp < now
  1466 + then (
  1467 + forget(remove(file_path));
  1468 + out_of_date(s)
  1469 + )
  1470 + else still_valid(s) // state has been successfully retrieved
  1471 + )
  1472 + else not_found.
  1473 +
  1474 +
  1475 +
  1476 + *** [1.2] Deleting out of date states.
  1477 +
  1478 + We also need to delete states which are out of date and which will never be deleted by
  1479 + the above method. This may be performed by a machine doing this periodically (say once
  1480 + per states life time period).
  1481 +
  1482 +define (List(String) file_names) -> One
  1483 + make_delete_out_of_date_states_function
  1484 + (
  1485 + Maybe($State) dummy,
  1486 + String state_directory
  1487 + ) =
  1488 + (List(String) file_names) |-df->
  1489 + if file_names is
  1490 + {
  1491 + [ ] then unique,
  1492 + [h . t] then
  1493 + with file_path = state_directory+"/"+h,
  1494 + if (RetrieveResult((Int32,$State)))retrieve(file_path) is ok(d)
  1495 + then (
  1496 + if d is (time_stamp,data) then
  1497 + if time_stamp < now
  1498 + then (forget(remove(file_path)); df(t))
  1499 + else df(t)
  1500 + )
  1501 + else (forget(remove(file_path)); df(t))
  1502 + }.
  1503 +
  1504 +
  1505 + The 'labelled arrow' |-df-> is documented in 'documentation/en/anubis_doc.txt'.
  1506 +
  1507 + Note: The argument 'dummy' (of type Maybe($State)) is not used in the body of the
  1508 + function (hence its name). Nevertheless, it is required. Indeed, the Anubis compiler
  1509 + does not accept a parameter in the body of a function (here the parameter is required
  1510 + by the use of 'retrieve') if this parameter does not appear in the type of the
  1511 + function. This is because this would create ambiguities that no explicit typing may
  1512 + ever resolve. If you put a double slash in front of the declaration of 'dummy' above,
  1513 + and if you compile this file, you will get a message like this one:
  1514 +
  1515 + Error in 'making_a_web_site.anubis', line 1300, column 7:
  1516 + A definition may not contain parameters which are not present
  1517 + in the declaration part (hidden parameters):
  1518 + $State
  1519 +
  1520 + The type of the function constructed by 'make_delete_out_of_date_states_function' is
  1521 + independant of the parameter $State. This is important because this allows to create
  1522 + the list of such functions for all web sites. From this list, it is possible to call
  1523 + the functions one after the other, so deleting out of date states for all web
  1524 + sites. Actually, the next function receives a list of pairs (state_directory,function),
  1525 + one for each web site.
  1526 +
  1527 +define One
  1528 + delete_out_of_date_states // for all web sites
  1529 + (
  1530 + List((String, List(String) -> One)) directories_and_functions
  1531 + ) =
  1532 + if directories_and_functions is
  1533 + {
  1534 + [ ] then unique,
  1535 + [h . t] then if h is (state_directory,function) then
  1536 + function(directory_list(state_directory,"s*"));
  1537 + delete_out_of_date_states(t)
  1538 + }.
  1539 +
  1540 +
  1541 + The above function must be called periodically in a separate virtual machine. The
  1542 + period we have choosen is (rather logically) the life time of states itself. This may
  1543 + be achieved by an 'infinite' loop, using a 'sleep(timeout)'. However, the loop must not
  1544 + be really infinite, because the servers may be shutdown. Hence, our loop must test
  1545 + (rather frequently; say every second) if the servers are down. If they are, the loop
  1546 + must be exited.
  1547 +
  1548 +define One
  1549 + delete_states_loop
  1550 + (
  1551 + List((String,List(String) -> One)) directories_and_functions,
  1552 + Int32 timeout,
  1553 + Int32 next_time,
  1554 + Server http_server,
  1555 + Server https_server,
  1556 + Var(Bool) shutdown_required
  1557 + ) =
  1558 + if *shutdown_required
  1559 + then (shutdown(http_server); shutdown(https_server))
  1560 + else unique;
  1561 + if (is_down(http_server) & is_down(https_server))
  1562 + then unique
  1563 + else if now > next_time
  1564 + then
  1565 + (
  1566 + delete_out_of_date_states(directories_and_functions);
  1567 + delete_states_loop(directories_and_functions,
  1568 + timeout,
  1569 + now+timeout,
  1570 + http_server,
  1571 + https_server,
  1572 + shutdown_required)
  1573 + )
  1574 + else
  1575 + (
  1576 + sleep(1000); // sleep just one second and try again
  1577 + delete_states_loop(directories_and_functions,
  1578 + timeout,
  1579 + next_time,
  1580 + http_server,
  1581 + https_server,
  1582 + shutdown_required)
  1583 + ).
  1584 +
  1585 + The above loop must be run in a separate virtual machine. This will be done just after
  1586 + the two servers are started.
  1587 +
  1588 +
  1589 +
  1590 +
  1591 +
  1592 + *** [2] Tools.
  1593 +
  1594 + *** [2.1] Directories.
  1595 +
  1596 + We need a tool for creating directories (if needed).
  1597 +
  1598 + (This tool has been moved to 'tools/basis.anubis').
  1599 +
  1600 +
  1601 +
  1602 +
  1603 + *** [2.2] Secondary documents.
  1604 +
  1605 + Some HTML elements (like '<object>', '<frame>') cannot receive their content directly
  1606 + from the current document, but only through an URL. For this reason, we implement a
  1607 + mecanism for creating secondary documents on the fly. To that end we use the 'private
  1608 + download' mecanism.
  1609 +
  1610 + A secondary document is formated by the same functions as the main document itself. The
  1611 + next function takes an 'off form' element, creates the file containing the secondary
  1612 + document in HTML format, and returns the URL at which the document will be available.
  1613 +
  1614 +define String
  1615 + create_secondary_document
  1616 + (
  1617 + String sd, // site directory
  1618 + String as, // authorization_secret
  1619 + String sn, // state name
  1620 + $T -> Printable_tree format_element,
  1621 + $T content,
  1622 + HTML_Size width
  1623 + ) =
  1624 + with private_download_directory = sd+"/private_download",
  1625 + hash = web_arg_encode(sha1(content)),
  1626 + file_content = (Printable_tree)
  1627 + [doctype_w3c_header,
  1628 + "<html><body><table ",
  1629 + if width is
  1630 + {
  1631 + absolute(w) then ["width=\"",w-25],
  1632 + percentage(w) then ["width=\"95%\""]
  1633 + },"\"><tr><td align=right>",
  1634 + format_element(content),
  1635 + "</td></tr></table></body></html>"
  1636 + ],
  1637 + file_name = "sd"+hash+".html",
  1638 + file_path = private_download_directory+"/"+file_name,
  1639 + if write_to_file(file_path,file_content) is
  1640 + {
  1641 + cannot_open_file then print("Cannot open file '"+file_path+"'.\n"); "",
  1642 + write_error(n) then print("Error writing file '"+file_path+"'.\n"); "",
  1643 + ok then file_name+"?zauth="+
  1644 + make_authorization(sd,as,private_download_directory+"/"+file_name)
  1645 + }.
  1646 +
  1647 +
  1648 +
  1649 +
  1650 + *** [2.3] Generating unique ids.
  1651 +
  1652 + In order to uniquely name object for JavaScript we generate unique ids from a counter.
  1653 +
  1654 +define Int32
  1655 + new_idnum
  1656 + (
  1657 + Var(Int32) ic_v // 'idnum' counter variable
  1658 + ) =
  1659 + protect
  1660 + with result = *ic_v+1,
  1661 + ic_v <- result;
  1662 + result.
  1663 +
  1664 +
  1665 +
  1666 +
  1667 +
  1668 +
  1669 + *** [3] Managing web arguments.
  1670 +
  1671 + Web arguments are those pairs 'name=value' which are transmitted through the HTTP
  1672 + protocol. We need precise naming conventions for these web arguments.
  1673 +
  1674 +
  1675 +
  1676 + *** [3.1] Prefixing web arguments names.
  1677 +
  1678 + We want to assign different roles to web arguments, and we also want to be able to
  1679 + recognize its role directly from the name of a web argument. The name "s" is reserved
  1680 + for the web argument whose value is the name of the current state. The name "a" is
  1681 + reserved for the web argument whose value is the name of the action to be
  1682 + performed. Other web arguments receive arbitrary names, and in order to avoid clashes,
  1683 + these names are prefixed by:
  1684 +
  1685 + "p" for names of password inputs,
  1686 + "o" for other web arguments
  1687 +
  1688 + The reason why password input names have a distinct prefix is that this allows the HTTP
  1689 + server to hide the passwords on the console of the server and in the journal.
  1690 +
  1691 +
  1692 +
  1693 +
  1694 + *** [3.2] Separating web arguments.
  1695 +
  1696 + When a new request arrives, we need to separate the web arguments, that is to say:
  1697 +
  1698 + - find the value of "s", and recover the corresponding state,
  1699 + - find the value of "a", which is the name of the action to be performed,
  1700 + - get the list of all the remaining web arguments (operands of the action).
  1701 +
  1702 + We must also determine if the previous state may be recovered. If it is not the case
  1703 + (either because the previous state name is invalid, or the previous state is out of
  1704 + date), we must check if there is an action name. Indeed, the presence of an action name
  1705 + indicates that the user has clicked on one of our buttons or links. If on the contrary
  1706 + there is no action name the user has just entered our address in his browser. In this
  1707 + last case, we must send the first page of our site (maybe a 'login' page), but if there
  1708 + is an action, we must send a page just saying that the session ticket has expired. If
  1709 + the previous state is recovered and there is no action, the new state is the same as
  1710 + the previous state.
  1711 +
  1712 + The result of the separation of the web arguments is of type:
  1713 +
  1714 +type Separated_Web_Args($State):
  1715 + swa(Maybe(PreviousState($State)) previous_state,
  1716 + Maybe(String) action_name,
  1717 + List(Web_arg) operands).
  1718 +
  1719 +
  1720 +
  1721 + The next function constructs the function which separates the web arguments.
  1722 +
  1723 +define (List(Web_arg) lwa) -> Separated_Web_Args($State)
  1724 + make_separate_web_args_function
  1725 + (
  1726 + String state_directory,
  1727 + String -> PreviousState($State) retrieve_state
  1728 + ) =
  1729 + (List(Web_arg) lwa) |-swaf->
  1730 + if lwa is
  1731 + {
  1732 + [ ] then
  1733 + //
  1734 + // no web arg found => no previous state and no action
  1735 + //
  1736 + swa(failure,failure,[]),
  1737 +
  1738 + [wa_1 . wa_others] then
  1739 + //
  1740 + // at least one web arg =>
  1741 + // separate other web args, and insert the first one as needed
  1742 + //
  1743 + if (Separated_Web_Args($State))swaf(wa_others) is
  1744 + {
  1745 + swa(ps1, // possible previous state
  1746 + an1, // maybe an action name
  1747 + op1) // operands so far
  1748 + then
  1749 + if wa_1 is
  1750 + {
  1751 + web_arg(n,v) then
  1752 + with prefix = if substr(n,0,4) = "amp;" then substr(n,4,1) else substr(n,0,1),
  1753 + name_start = (Int32)(if substr(n,0,4) = "amp;" then 5 else 1),
  1754 + if prefix = "s" then
  1755 + swa(success(retrieve_state(v)),an1,op1) else
  1756 + if prefix = "a" then
  1757 + swa(ps1,success(v),op1) else
  1758 + if prefix = "t" then
  1759 + swa(ps1,an1,[web_arg("target",v) . op1]) else
  1760 + if prefix = "p" then
  1761 + swa(ps1,an1,[web_arg(substr(n,name_start,length(n)-name_start),v) . op1]) else
  1762 + if prefix = "o" then
  1763 + swa(ps1,an1,[web_arg(substr(n,name_start,length(n)-name_start),v) . op1]) else
  1764 + swa(ps1,an1,op1),
  1765 +
  1766 + upload(n,v,t) then
  1767 + swa(ps1,an1,[upload(substr(n,1,length(n)-1),v,t) . op1])
  1768 + }}
  1769 + }.
  1770 +
  1771 +
  1772 +
  1773 +
  1774 +
  1775 +
  1776 + *** [3.3] Applying an action.
  1777 +
  1778 + When the web arguments are separated (and their names cleaned up from prefixes), we may
  1779 + apply the action to the operands and the current state. We search for the action to be
  1780 + applied in the list of actions. If no action is found, the new state is the same as
  1781 + the previous state. Also, we deny the application of an HTTP action if the request
  1782 + arrives through the HTTPS channel and conversely.
  1783 +
  1784 +
  1785 +define (Maybe($State) previous,
  1786 + String action_name,
  1787 + HTTP_Info http_info,
  1788 + List(Web_arg) lwa,
  1789 + Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header))
  1790 + make_apply_action_function
  1791 + (
  1792 + List(Web_Action($SessionTicket, $State)) actions
  1793 + ) =
  1794 + with f =
  1795 + (Maybe($State) previous,
  1796 + String action_name,
  1797 + HTTP_Info http_info,
  1798 + List(Web_arg) lwa,
  1799 + Bool is_https,
  1800 + List(Web_Action($SessionTicket, $State)) actions) |-f->
  1801 + if actions is
  1802 + {
  1803 + [ ] then (print("action '"+action_name+
  1804 + "' not found.\n"); (failure, previous, [])),
  1805 + [ac1 . others] then if ac1 is
  1806 + {
  1807 + http_action(an,allow,do_it) then
  1808 + if an = action_name
  1809 + then if is_https
  1810 + then (print("HTTP action '"+an+
  1811 + "' called through HTTPS (denied).\n");
  1812 + (failure, previous, []))
  1813 + else if allow(previous)
  1814 + then do_it(http_info,lwa,previous)
  1815 + else (failure, previous, [])
  1816 + else f(previous,action_name,http_info,lwa,is_https,others),
  1817 +
  1818 + https_action(an,allow,do_it) then
  1819 + if an = action_name
  1820 + then if is_https
  1821 + then if allow(previous)
  1822 + then do_it(http_info,lwa,previous)
  1823 + else (failure, previous, [])
  1824 + else (print("HTTPS action '"+an+
  1825 + "' called through HTTP (denied).\n");
  1826 + (failure, previous, []))
  1827 + else f(previous,action_name,http_info,lwa,is_https,others),
  1828 +
  1829 + http_https_action(an,allow,do_it) then
  1830 + if an = action_name
  1831 + then if allow(previous)
  1832 + then do_it(http_info,lwa,previous)
  1833 + else (failure, previous, [])
  1834 + else f(previous,action_name,http_info,lwa,is_https,others),
  1835 +
  1836 + }
  1837 + },
  1838 + (Maybe($State) previous,
  1839 + String action_name,
  1840 + HTTP_Info http_info,
  1841 + List(Web_arg) lwa,
  1842 + Bool is_https) |->
  1843 + f(previous,action_name,http_info,lwa,is_https,actions).
  1844 +
  1845 +
  1846 +
  1847 +
  1848 +
  1849 +
  1850 +
  1851 +
  1852 + *** [4] Web site descriptions and the 'awp handlers'.
  1853 +
  1854 + *** [4.1] The type 'Web_Site'.
  1855 +
  1856 + The type 'Web_Site_Description' is defined in 'web/multihost_http_server.anubis'. We
  1857 + need another one, because, we have some extra informations to record for each site.
  1858 +
  1859 +public type Web_Site:
  1860 + web_site((Int32,Int32) -> Web_Site_Description description,
  1861 + List(String) -> One delete_out_of_date).
  1862 +
  1863 +
  1864 +
  1865 +
  1866 + *** [4.2] Making a web site description.
  1867 +
  1868 + Below is the function which creates a web site description. It first creates (if
  1869 + needed) the directories for the site, then constructs the tool functions for the site,
  1870 + and the site handler. Finally, it constructs the web site description.
  1871 +
  1872 + We gather common (constant) informations in the following type:
  1873 +
  1874 +type CommonInfo:
  1875 + info(String common_name,
  1876 + Int32 http_port,
  1877 + Int32 https_port,
  1878 + String site_directory,
  1879 + String authorization_secret
  1880 + ).
  1881 +
  1882 + We need a forward declaration.
  1883 +
  1884 +public define Printable_tree
  1885 + format
  1886 + (
  1887 + CommonInfo cinfo,
  1888 + String state_name,
  1889 + HTML_Page page,
  1890 + Bool is_https,
  1891 + String charset
  1892 + ).
  1893 +
  1894 +
  1895 +define Printable_tree
  1896 + format
  1897 + (
  1898 + HTML_Size s
  1899 + ) =
  1900 + if s is
  1901 + {
  1902 + absolute(x) then ["\"",x,"\""],
  1903 + percentage(x) then ["\"",x,"%\""]
  1904 + }.
  1905 +
  1906 +define Printable_tree
  1907 + top_redirection_page
  1908 + (
  1909 + String common_name
  1910 + ) =
  1911 + [ doctype_w3c_header,
  1912 + "<html><head>",
  1913 + "<meta http-equiv=\"Refresh\" content=\"0; URL=javascript:void window.open('/?t=','_top')\">",
  1914 + "</head><body></body></html>"
  1915 + ].
  1916 +
  1917 +public define Web_Site
  1918 + make_web_site_description
  1919 + (
  1920 + List(String) common_names, // for example: ["www.our-business.com"]
  1921 + String site_directory,
  1922 + One -> One init,
  1923 + (HTTP_Info) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) initial_state,
  1924 + ($State expired,
  1925 + HTTP_Info,
  1926 + List(Web_arg),
  1927 + Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) ticket_expired_state,
  1928 + (HTTP_Info,
  1929 + List(Web_arg),
  1930 + Bool is_https) -> (Maybe($SessionTicket), Maybe($State), List(HTTP_header)) ticket_lost_state,
  1931 + List(Web_Action($SessionTicket, $State)) actions,
  1932 + (Maybe($SessionTicket), Maybe($State)) -> HTML_Page compute_page,
  1933 + Int32 timeout,
  1934 + List(Redirection) redirections,
  1935 + String charset,
  1936 + List(String) journal_extensions,
  1937 + List(String) journal_headers,
  1938 + String secret,
  1939 + List(MIME) known_mime_types,
  1940 + (String action_name,
  1941 + List(Web_arg) args) -> One before_send_file
  1942 + ) =
  1943 + init(unique);
  1944 +
  1945 +
  1946 + //
  1947 + // make required directories (if needed)
  1948 + //
  1949 + with web_sites_directory = make_directory(my_anubis_directory+"/web_sites"),
  1950 + base_directory = make_directory(site_directory),
  1951 + state_directory = make_directory(site_directory+"/states"),
  1952 + forget(make_directory(site_directory+"/public"));
  1953 + //
  1954 + // construct tool functions
  1955 + //
  1956 + with save_state = make_save_state_function(timeout,state_directory),
  1957 + retrieve_state = make_retrieve_state_function(state_directory),
  1958 + separate_web_args = make_separate_web_args_function(state_directory,retrieve_state),
  1959 + apply_action = make_apply_action_function(actions),
  1960 + //
  1961 + // construct the site handler
  1962 + //
  1963 + site_handler = (Int32 http_port, Int32 https_port) |->
  1964 + ((String host_name,
  1965 + HTTP_Info http_info,
  1966 + List(Web_arg) lwa,
  1967 + Bool is_https) |->
  1968 + ((List(HTTP_header),Printable_tree))
  1969 + if separate_web_args(lwa) is
  1970 + {
  1971 + swa(mb_previous_state,mb_action_name,operands) then
  1972 + with state_and_headers = if mb_previous_state is
  1973 + {
  1974 + failure then
  1975 + if mb_action_name is
  1976 + {
  1977 + failure then initial_state(http_info),
  1978 + success(action_name) then
  1979 + apply_action(failure,action_name,http_info,operands,is_https)
  1980 + },
  1981 + success(previous_state) then if previous_state is
  1982 + {
  1983 + not_found then
  1984 + if mb_action_name is
  1985 + {
  1986 + failure then initial_state(http_info),
  1987 + success(_) then
  1988 + ticket_lost_state(http_info,lwa,is_https)
  1989 + },
  1990 +
  1991 + out_of_date(state) then
  1992 + ticket_expired_state(state,http_info,lwa,is_https),
  1993 +
  1994 + still_valid(state) then
  1995 + if mb_action_name is
  1996 + {
  1997 + failure then (failure, success(state), []),
  1998 + success(action_name) then
  1999 + apply_action(success(state),action_name,http_info,operands,is_https)
  2000 + }
  2001 + }
  2002 + },
  2003 + if state_and_headers is (session_ticket, mb_new_state, headers) then
  2004 + with state_name = save_state(mb_new_state),
  2005 + (headers,
  2006 + format(info(host_name, http_port, https_port, site_directory, secret),
  2007 + state_name,
  2008 + compute_page(session_ticket, mb_new_state),
  2009 + is_https,
  2010 + charset))
  2011 + }),
  2012 + //
  2013 + // make the delete_out_of_date function
  2014 + //
  2015 + delete_out_of_date =
  2016 + make_delete_out_of_date_states_function((Maybe($State))failure,
  2017 + site_directory+"/states"),
  2018 + //
  2019 + // construct the web site description
  2020 + //
  2021 + web_site((Int32 http_port, Int32 https_port) |->
  2022 + web_site_description(common_names,
  2023 + site_directory,
  2024 + redirections,
  2025 + charset,
  2026 + journal_extensions,
  2027 + journal_headers,
  2028 + secret,
  2029 + known_mime_types,
  2030 + site_handler(http_port,https_port),
  2031 + (List(Web_arg) lwa) |-> if separate_web_args(lwa) is
  2032 + swa(mb_previous_state,mb_action_name,operands) then
  2033 + if mb_action_name is
  2034 + {
  2035 + failure then unique
  2036 + success(an) then before_send_file(an,operands)
  2037 + }),
  2038 + delete_out_of_date).
  2039 +
  2040 +
  2041 +
  2042 +
  2043 + *** [4.3] Starting the servers.
  2044 +
  2045 +public define Start_Web_Sites_Result
  2046 + start_web_sites
  2047 + (
  2048 + Int32 ip_address, // the IP address shared by the web sites
  2049 + Int32 http_port, // usually: 80
  2050 + Int32 https_port, // usually: 443
  2051 + String ssl_certificate_common_name,
  2052 + List(Web_Site) web_sites, // web sites to be started
  2053 + Var(Bool) shutdown_required
  2054 + ) =
  2055 + with get_description = (Web_Site ws) |-> description(ws)(http_port,https_port),
  2056 + with http_server_r =
  2057 + start_http_server(ip_address,http_port,
  2058 + map(get_description,web_sites),
  2059 + load_denial_of_service_info),
  2060 + with https_server_r =
  2061 + start_https_server(ip_address,https_port,
  2062 + ssl_certificate_common_name,
  2063 + map(get_description,web_sites),
  2064 + load_denial_of_service_info),
  2065 + if http_server_r is ok(http_server)
  2066 + then
  2067 + (
  2068 + if https_server_r is ok(https_server)
  2069 + then
  2070 + (
  2071 + start_http_servers_tasks(map(get_description,web_sites),
  2072 + [http_server,https_server],
  2073 + 600); // period of 10 minutes
  2074 + delegate
  2075 + delete_states_loop(
  2076 + map((Web_Site ws) |->
  2077 + (site_directory(description(ws)(http_port,https_port))+
  2078 + "/states",delete_out_of_date(ws)),
  2079 + web_sites),
  2080 + 3600*24*3, // keep out of date states 3 days
  2081 + now,
  2082 + http_server,
  2083 + https_server,
  2084 + shutdown_required),
  2085 + ok(http_server,https_server)
  2086 + )
  2087 + else cannot_bind_to_port(https_port)
  2088 + )
  2089 + else
  2090 + (
  2091 + if https_server_r is ok(https_server)
  2092 + then cannot_bind_to_port(http_port)
  2093 + else cannot_bind_to_port(http_port,https_port)
  2094 + ).
  2095 +
  2096 +
  2097 +public define One
  2098 + start_web_sites
  2099 + (
  2100 + Int32 ip_address, // the IP address shared by the web sites
  2101 + Int32 http_port, // usually: 80
  2102 + Int32 https_port, // usually: 443
  2103 + String ssl_certificate_common_name,
  2104 + List(Web_Site) web_sites, // web sites to be started
  2105 + Var(Bool) shutdown_required
  2106 + ) =
  2107 + if (Start_Web_Sites_Result)start_web_sites(ip_address,
  2108 + http_port,
  2109 + https_port,
  2110 + ssl_certificate_common_name,
  2111 + web_sites,
  2112 + shutdown_required) is
  2113 + {
  2114 + cannot_bind_to_port(n) then print("Cannot bind to port: "+n+"\n"),
  2115 + cannot_bind_to_port(n,m) then print("Cannot bind to ports: "+n+", "+m+"\n"),
  2116 + ok(s1,s2) then print("Servers started.\n")
  2117 + }.
  2118 +
  2119 +
  2120 +
  2121 +
  2122 +
  2123 + *** [5] HTML Formating.
  2124 +
  2125 + We need to translate HTML elements as defined above into actual HTML text.
  2126 +
  2127 + Actioners require special informations, which must be transmitted when needed by the
  2128 + 'format' functions:
  2129 +
  2130 + - the 'common name', which is used for URLs,
  2131 + - the HTTP/HTTPS port number,
  2132 + - the 'state name', which must be transmitted when the actioner is clicked upon,
  2133 + - the 'form name' (if any) to which the actioner refers.
  2134 +
  2135 + If the actioner is off form, and if it refers to a form, the name of that form is
  2136 + already known by the actioner. On the contrary, if the actioner is 'in form', it refers
  2137 + implicitly to the form containing it. The name of that form is transmitted to the
  2138 + 'format' functions called from within the formating of that form.
  2139 +
  2140 +
  2141 +
  2142 +
  2143 + *** [5.1] The type 'HTML_Any($T)'.
  2144 +
  2145 + The type 'HTML_Any($T)' gathers elements which may be put anywhere in the page. The
  2146 + parameter $T becomes either 'HTML_Off_Form' or 'HTML_In_Form'.
  2147 +
  2148 +type HTML_Any($T):
  2149 + any_text (List(Text_Option), String the_text),
  2150 + any_preformated (List(Text_Option), String),
  2151 + any_paragraph (List(Text_Option), String the_text),
  2152 + any_image (String url),
  2153 + any_image (String url, Int32 width, Int32 height),
  2154 + any_table (List(Table_Option), List(HTML_Row($T))),
  2155 + any_center ($T),
  2156 + any_mail_to (String email, $T element),
  2157 + any_scroller (Int32 width, Int32 height,
  2158 + Int32 content_width, Int32 content_height,
  2159 + $T content),
  2160 + any_fixed_size (HTML_Size width, HTML_Size height, $T content),
  2161 + any_fixed_size_2 (HTML_Size width, HTML_Size height, String name_of_HTML_file),
  2162 + any_actioner (Actioner_Connection,
  2163 + Actioner_Target,
  2164 + Actioner_Aspect,
  2165 + String action_name,
  2166 + List((String,String)) extra_ops,
  2167 + List(Actioner_Local_Action),
  2168 + Maybe(String) form_name),
  2169 + any_foreign_link (List(Text_Option), String url, String name),
  2170 + any_private_download (String abs_path, String name, String extra_ext,
  2171 + Maybe((String,List((String,String))))),
  2172 + any_div (List(DIV_Option), $T element),
  2173 + any_div_empty (List(DIV_Option)),
  2174 + any_coreattrs (List(CoreAttrs)).
  2175 +
  2176 +
  2177 +
  2178 + *** [5.2] Formating a color.
  2179 +
  2180 + RGB colors are formatted as '#rrggbb' where rr, gg and bb are two characters
  2181 + hexadecimal values.
  2182 +
  2183 +define String
  2184 + html_format
  2185 + (
  2186 + RGB color
  2187 + ) =
  2188 + if color is rgb(r,g,b) then
  2189 + "#" + hexadecimal(word8_to_int32(r),2)
  2190 + + hexadecimal(word8_to_int32(g),2)
  2191 + + hexadecimal(word8_to_int32(b),2).
  2192 +
  2193 +
  2194 + The following is a very arbitrary definition of the opposite color. The thing which is
  2195 + important is that it is far from the original, so that characters in 'opposite' color
  2196 + are clearly visible over the original.
  2197 +
  2198 +define RGB
  2199 + opposite
  2200 + (
  2201 + RGB color
  2202 + ) =
  2203 + if color is rgb(r,g,b) then
  2204 + with r1 = word8_to_int32(r),
  2205 + with g1 = word8_to_int32(g),
  2206 + with b1 = word8_to_int32(b),
  2207 + rgb(truncate_to_word8(255-r1),
  2208 + truncate_to_word8(255-g1),
  2209 + truncate_to_word8(255-b1)).
  2210 +
  2211 +
  2212 +
  2213 +
  2214 + *** [5.3] Creating buttons.
  2215 +
  2216 + We want to be able to create buttons in the form of a pair of images (rollovers)
  2217 + automatically. We use the JPEG interface, because for the time being Anubis cannot
  2218 + handle other kinds of images.
  2219 +
  2220 +
  2221 + Computing printed text length.
  2222 +
  2223 + define Int32
  2224 + printed_text_width
  2225 + (
  2226 + Word8 -> Int32 char_size,
  2227 + List(Word8) l
  2228 + ) =
  2229 + if l is
  2230 + {
  2231 + [] then (Int32) 0,
  2232 + [h . t] then char_size(h) + 1+ printed_text_width(char_size,t)
  2233 + }.
  2234 +
  2235 + define Int32
  2236 + printed_text_width
  2237 + (
  2238 + SystemFont font,
  2239 + String s
  2240 + ) =
  2241 + printed_text_width((Word8 c) |-> word8_to_int32(width(get_char_info(font,c))),
  2242 + explode(s)).
  2243 +
  2244 +
  2245 +
  2246 + Converting RGB to RGBA.
  2247 +
  2248 +define RGBA
  2249 + to_rgba
  2250 + (
  2251 + RGB color
  2252 + ) =
  2253 + if color is rgb(r,g,b) then rgba(r,g,b,255).
  2254 +
  2255 +
  2256 + Drawing a 'relief'.
  2257 +
  2258 + define One
  2259 + draw_relief
  2260 + (
  2261 + RGBAImage dest,
  2262 + RGBA color,
  2263 + Int32 contrast,
  2264 + Int32 x,
  2265 + Int32 y,
  2266 + Int32 width,
  2267 + Int32 height
  2268 + ) =
  2269 + with l = lighten(color,contrast),
  2270 + d = darken(color,contrast),
  2271 + draw_rectangle(dest,rect(x,y,x+width,y+1),l);
  2272 + draw_rectangle(dest,rect(x,y+1,x+1,y+height),l);
  2273 + draw_rectangle(dest,rect(x+width-1,y+1,x+width,y+height),d);
  2274 + draw_rectangle(dest,rect(x+1,y+height-1,x+width-1,y+height),d).
  2275 +
  2276 +
  2277 + Creating a button background.
  2278 +
  2279 + define RGBAImage
  2280 + create_button_background
  2281 + (
  2282 + RGBA color,
  2283 + Int32 width,
  2284 + Int32 height
  2285 + ) =
  2286 + with result = create_rgba_image(width,height,color),
  2287 + draw_relief(result,color,100,0,0,width,height);
  2288 + draw_relief(result,color,70,1,1,width-2,height-2);
  2289 + draw_relief(result,color,55,2,2,width-4,height-4);
  2290 + draw_relief(result,color,35,3,3,width-6,height-6);
  2291 + draw_relief(result,color,20,4,4,width-8,height-8);
  2292 + draw_relief(result,color,10,5,5,width-10,height-10);
  2293 + draw_relief(result,color,5,6,6,width-12,height-12);
  2294 + result.
  2295 +
  2296 +
  2297 + Drawing the text over the background.
  2298 +
  2299 + define One
  2300 + draw_button_text
  2301 + (
  2302 + RGBAImage image,
  2303 + String text,
  2304 + Int32 text_index,
  2305 + Int32 pixel_x,
  2306 + Int32 y,
  2307 + Rectangle clip,
  2308 + RGBA color,
  2309 + SystemFont font,
  2310 + ) =
  2311 + if nth(text_index,text) is
  2312 + {
  2313 + failure then unique,
  2314 + success(c) then
  2315 + with cw = draw_system_character(image,clip,pixel_x,y,font,word8_to_int32(c),color),
  2316 + draw_button_text(image,text,text_index+1,pixel_x+cw+1,y,clip,color,font)
  2317 + }.
  2318 +
  2319 + define One
  2320 + draw_button_text
  2321 + (
  2322 + RGBAImage image,
  2323 + String text,
  2324 + Int32 text_width,
  2325 + RGBA light_color,
  2326 + RGBA dark_color,
  2327 + SystemFont font
  2328 + ) =
  2329 + with image_width = width(image),
  2330 + image_height = height(image),
  2331 + x_pos = (image_width-text_width)>>1,
  2332 + clip = rect(0,0,image_width,image_height),
  2333 + new_light_color = lighten(light_color,150),
  2334 + new_dark_color = darken(dark_color,40),
  2335 + draw_button_text(image, text, 0, x_pos+2, 16, clip, new_dark_color, font);
  2336 + draw_button_text(image, text, 0, x_pos, 14, clip, new_light_color, font).
  2337 +
  2338 +
  2339 + The next function creates the two images for a button. The information given is the
  2340 + main color of the button, the text of the button and the minimal width (in pixels) of
  2341 + the button. The function does not create the button if the images already exist. The
  2342 + two images are stored in the directory 'site_directory/buttons'. The names of the files
  2343 + are of the form:
  2344 +
  2345 + bxxxx_off.jpg
  2346 + bxxxx_on.jpg
  2347 +
  2348 + where the prefix 'b' is to avoid leading '-' which may perturb UNIX commands (like
  2349 + 'rm'), and where 'xxxx' is created from the given informations by the formula:
  2350 +
  2351 + xxxx = web_arg_encode(sha1((color,text,width)))
  2352 +
  2353 + Hence, distinct informations give distinct file names.
  2354 +
  2355 +
  2356 + define String // returns xxxx
  2357 + create_button_images
  2358 + (
  2359 + String site_directory,
  2360 + RGBA color,
  2361 + String text,
  2362 + Int32 width,
  2363 + SystemFont font
  2364 + ) =
  2365 + with xxxx = web_arg_encode(sha1((color,text,width))),
  2366 + buttons_dir = site_directory+"/public/buttons",
  2367 + off_filepath = buttons_dir+"/b"+xxxx+"_off.jpg",
  2368 + on_filepath = buttons_dir+"/b"+xxxx+"_on.jpg",
  2369 + if file_exists(on_filepath)
  2370 + then xxxx
  2371 + else with
  2372 + text_width = printed_text_width(font,text),
  2373 + button_width = max(width,text_width+12),
  2374 + button_height = (Int32)20,
  2375 + light_color = lighten(color,60),
  2376 + very_light_color = lighten(light_color,30),
  2377 + dark_color = darken(color,40),
  2378 + background_off =
  2379 + create_button_background(color,button_width,button_height),
  2380 + background_on =
  2381 + create_button_background(light_color,button_width,button_height),
  2382 +
  2383 + draw_button_text(background_off,text,text_width,very_light_color,dark_color,font);
  2384 + draw_button_text(background_on, text,text_width,very_light_color,dark_color,font);
  2385 + forget(write_image_to_JPEG_file(to_JPEG(background_off),
  2386 + off_filepath,
  2387 + 100));
  2388 + forget(write_image_to_JPEG_file(to_JPEG(background_on),
  2389 + on_filepath,
  2390 + 100));
  2391 + xxxx.
  2392 +
  2393 +
  2394 +
  2395 +
  2396 +
  2397 + *** [5.4] Formating an actioner.
  2398 +
  2399 + An actioner works as follows. Assume first that it refers to a form. When it is clicked
  2400 + upon, the actioner puts (via 'onMouseDown') the URL into the 'action' attribute of the
  2401 + form, and submits the form, using the JavaScript command 'form_name.submit()'. If the
  2402 + actioner does not refer to a form, it fires the URL directly via 'href', because in
  2403 + that case, the actioner is always an <a> tag.
  2404 +
  2405 + The URL itself is composed using the connection sort (same, http or https), the common
  2406 + name and port number (if needed), the state name, the action name, and the extra
  2407 + operands, which are put into a query string. It may look like this:
  2408 +
  2409 + http://common_name:port/?s=state_name&a=action_name&oname=value...
  2410 +
  2411 + Each extra operand is a pair of strings: (name,value). It is formated as:
  2412 +
  2413 + &oname=value
  2414 +
  2415 +
  2416 +define String
  2417 + format_extra_operands
  2418 + (
  2419 + List((String,String)) l
  2420 + ) =
  2421 + if l is
  2422 + {
  2423 + [ ] then "",
  2424 + [h . t] then if h is (n,v) then
  2425 + "&amp;o"+n+"="+v+format_extra_operands(t)
  2426 + }.
  2427 +
  2428 +
  2429 + It seams that the standard requires "&amp;" instead of "&" !
  2430 +
  2431 + In case the target is another window, we need to format the options for this window.
  2432 +
  2433 +define String
  2434 + format
  2435 + (
  2436 + List(Other_Window_Option) l
  2437 + ) =
  2438 + if l is
  2439 + {
  2440 + [ ] then "",
  2441 + [h . t] then if h is
  2442 + {
  2443 + resizable then "resizable",
  2444 + scrollbars then "scrollbars",
  2445 + width(w) then "width="+w,
  2446 + height(h) then "height="+h
  2447 + } + if t is [ ] then "" else (","+format(t))
  2448 + }.
  2449 +
  2450 +
  2451 +
  2452 + Formating choices for a <select> tag.
  2453 +
  2454 +public define Printable_tree
  2455 + format_choices
  2456 + (
  2457 + List(String) l
  2458 + ) =
  2459 + if l is
  2460 + {
  2461 + [ ] then [ ],
  2462 + [h . t] then ["<option>",h . format_choices(t)]
  2463 + }.
  2464 +
  2465 +
  2466 +public define Printable_tree
  2467 + format_choices
  2468 + (
  2469 + List(String) l,
  2470 + String selected
  2471 + ) =
  2472 + if l is
  2473 + {
  2474 + [ ] then [ ],
  2475 + [h . t] then if h = selected
  2476 + then ["<option selected>",h . format_choices(t)]
  2477 + else ["<option>",h . format_choices(t,selected)]
  2478 + }.
  2479 +
  2480 +
  2481 +public define Printable_tree
  2482 + format_choices
  2483 + (
  2484 + List((String,String)) l
  2485 + ) =
  2486 + if l is
  2487 + {
  2488 + [ ] then [ ],
  2489 + [h . t] then
  2490 + if h is (val,item)
  2491 + then ["<option value=\""+val+"\">",item . format_choices(t)]
  2492 + }.
  2493 +
  2494 +public define Printable_tree
  2495 + format_choices
  2496 + (
  2497 + List((String,String)) l,
  2498 + String selected
  2499 + ) =
  2500 + if l is
  2501 + {
  2502 + [ ] then [ ],
  2503 + [h . t] then
  2504 + if h is (val,item) then
  2505 + if item = selected
  2506 + then ["<option value=\""+val+"\" selected>",item . format_choices(t)]
  2507 + else ["<option value=\""+val+"\">",item . format_choices(t,selected)]
  2508 + }.
  2509 +
  2510 +
  2511 +
  2512 +variable Int32 count = 0.
  2513 +
  2514 + Note: this counter is private to the virtual machine, hence there is one counter by
  2515 + client.
  2516 +
  2517 +define Int32
  2518 + new_count
  2519 + =
  2520 + count <- *count+1;
  2521 + *count.
  2522 +
  2523 +
  2524 + The next function composes the URL. It is a JavaScript URL when the target is another
  2525 + window.
  2526 +
  2527 +define String
  2528 + make_actioner_url
  2529 + (
  2530 + CommonInfo cinfo,
  2531 + Actioner_Connection connection,
  2532 + Actioner_Target target,
  2533 + String state_name,
  2534 + String action_name,
  2535 + List((String,String)) extra_ops,
  2536 + Bool is_https
  2537 + ) =
  2538 + if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
  2539 + with strict_url =
  2540 + if connection is
  2541 + {
  2542 + same then "/",
  2543 + /*
  2544 + same then if is_https
  2545 + then "https://"+common_name+":"+https_port+"/"
  2546 + else "http://"+common_name+":"+https_port+"/",
  2547 + */
  2548 +
  2549 + http then "http://"+common_name+":"+http_port+"/",
  2550 + https then "https://"+common_name+":"+https_port+"/",
  2551 + } +
  2552 + "?s=" + state_name + "&amp;a=" + action_name +
  2553 + format_extra_operands(extra_ops),
  2554 + if target is
  2555 + {
  2556 + same then strict_url,
  2557 + same(label) then strict_url+"#"+label,
  2558 + other(wn,ops) then
  2559 + "javascript:void window.open('"+strict_url+"&amp;t="+wn+"','"+
  2560 + "w"+to_ascii(sha1(wn))+"','"+format(ops)+"')"
  2561 + }.
  2562 +
  2563 +
  2564 + Depending on the fact that the actioner refers to a form or not, the URL is used in two
  2565 + different ways. If the actioner does not refer to a form, it is realized by a '<a>'
  2566 + tag, with a 'href' attribute. If it refers to a form, it is still realized by a '<a>'
  2567 + tag, but with no href attribute. In this case, we use the 'onMouseDown' or 'onChange'
  2568 + event handler. The handler calls a JavaScript function which puts the URL as the value
  2569 + of the 'action' attribute of the form, and submits the form.
  2570 +
  2571 +type URL_or_JavaScript:
  2572 + url (String),
  2573 + javascript (Printable_tree script, Printable_tree handler).
  2574 +
  2575 + define URL_or_JavaScript
  2576 + format_action
  2577 + (
  2578 + String the_url,
  2579 + Maybe(String) mb_form_name
  2580 + ) =
  2581 + url(the_url).
  2582 +
  2583 +
  2584 + It was as shown below, in order to allow submission of a form from outside the form,
  2585 + but this makes problems:
  2586 +
  2587 +define URL_or_JavaScript
  2588 + format_action
  2589 + (
  2590 + String the_url,
  2591 + Maybe(String) mb_form_name
  2592 + ) =
  2593 + if mb_form_name is
  2594 + {
  2595 + failure then
  2596 + url(the_url),
  2597 + success(form_name) then
  2598 + with n = new_count,
  2599 + javascript(
  2600 + [
  2601 + "<script type=\"text/javascript\" language =\"JavaScript\">\n",
  2602 + "function pfu",form_name,n,"() {\n",
  2603 + " var fa = document.forms.f",form_name,";\n",
  2604 + " var u = \"",the_url,"\";\n",
  2605 + " fa.action = u;\n",
  2606 + " fa.submit(); }",
  2607 + "</script>"
  2608 + ],
  2609 + ["pfu",form_name,n,"();"]
  2610 + )
  2611 + }.
  2612 +
  2613 +
  2614 +
  2615 + Now, we format the actioner according to its aspect.
  2616 +
  2617 +define List(Text_Option)
  2618 + get_text_options
  2619 + (
  2620 + List(Text_Option) l
  2621 + )
  2622 + =
  2623 + if l is
  2624 + {
  2625 + [] then [],
  2626 + [h . t ] then
  2627 + if h is class(class) then
  2628 + get_text_options(t)
  2629 + else
  2630 + [ h . get_text_options(t) ]
  2631 +
  2632 + }.
  2633 +
  2634 + /**
  2635 + * Extract the CSS class list from the list of Text_Option
  2636 + */
  2637 +define List(Text_Option)
  2638 + get_css_class
  2639 + (
  2640 + List(Text_Option) l
  2641 + )
  2642 + =
  2643 + if l is
  2644 + {
  2645 + [] then [],
  2646 + [h . t ] then
  2647 +
  2648 +
  2649 + if h is class(class) then
  2650 + [ h . get_css_class(t) ]
  2651 + else
  2652 + get_css_class(t)
  2653 + }
  2654 + .
  2655 +
  2656 +define String
  2657 + format_text_options
  2658 + (
  2659 + List(Text_Option) l
  2660 + )
  2661 + =
  2662 + with text_options = get_text_options(l),
  2663 + css_classes = get_css_class(l),
  2664 + if text_options is
  2665 + {
  2666 + [] then "",
  2667 + [_._] then " style=\"" + format(text_options) + "\" "
  2668 + }
  2669 + +
  2670 + if css_classes is
  2671 + {
  2672 + [] then "",
  2673 + [_._] then format(css_classes)
  2674 + }.
  2675 +
  2676 +define Printable_tree
  2677 + format
  2678 + (
  2679 + List(Actioner_Local_Action) l
  2680 + ) =
  2681 + if l is
  2682 + {
  2683 + [ ] then [ ],
  2684 + [h . t] then [if h is
  2685 + {
  2686 + close_window then [" window.close(); "]
  2687 + }
  2688 + . format(t)]
  2689 + }.
  2690 +
  2691 +define String
  2692 + format_coreattrs
  2693 + (
  2694 + List(CoreAttrs) attributs
  2695 + )=
  2696 + if attributs is
  2697 + {
  2698 + [] then "",
  2699 + [h .t] then
  2700 + with current = if h is
  2701 + {
  2702 + id(id_name) then
  2703 + " id=\"" + id_name + "\"",
  2704 + class(class_name) then
  2705 + " class=\"" + class_name + "\"",
  2706 + style(style_string) then
  2707 + " style=\"" + style_string + "\"",
  2708 +
  2709 + title(title_string) then
  2710 + " title=\"" + title_string + "\"",
  2711 + },
  2712 + current + format_coreattrs(t)
  2713 + }.
  2714 +
  2715 +define String
  2716 + _format
  2717 + (
  2718 + List(DIV_Option) opt
  2719 + )=
  2720 + if opt is
  2721 + {
  2722 + [] then "",
  2723 + [h .t] then
  2724 + with current = if h is
  2725 + {
  2726 + id(id_name) then
  2727 + " id=\"" + id_name + "\"",
  2728 + class(class_name) then
  2729 + " class=\"" + class_name + "\"",
  2730 + style(style_string) then
  2731 + " style=\"" + style_string + "\"",
  2732 +
  2733 + title(title_string) then
  2734 + " title=\"" + title_string + "\"",
  2735 + lang(lang) then
  2736 + " xml:lang=" + lang,
  2737 + dir(reading_Way) then
  2738 + if reading_Way is
  2739 + {
  2740 + ltr then " dir=ltr",
  2741 + rtl then " dir=rtl"
  2742 + }
  2743 + },
  2744 + current + _format(t)
  2745 + }
  2746 + .
  2747 +
  2748 +define Printable_tree
  2749 + format_div_option
  2750 + (
  2751 + List(DIV_Option) options
  2752 + )=
  2753 + ["<DIV" + _format(options) + ">"] .
  2754 +
  2755 +
  2756 +define Printable_tree
  2757 + format_actioner
  2758 + (
  2759 + CommonInfo cinfo,
  2760 + String state_name,
  2761 + Actioner_Connection connection,
  2762 + Actioner_Target target,
  2763 + Actioner_Aspect aspect,
  2764 + String action_name,
  2765 + List((String,String)) extra_ops,
  2766 + List(Actioner_Local_Action) local_actions,
  2767 + Maybe(String) mb_form_name,
  2768 + Bool is_https,
  2769 + ) =
  2770 + if cinfo is info(common_name,http_port,https_port,site_dir,secret) then
  2771 + with url = make_actioner_url(cinfo,connection,target,
  2772 + state_name,action_name,extra_ops,is_https),
  2773 + with action = format_action(url,mb_form_name),
  2774 + if aspect is
  2775 + {
  2776 +
  2777 + link(opt, text) then [
  2778 + if action is
  2779 + {
  2780 + url(u) then
  2781 + ["<a href=\"",u,"\"", format_text_options(opt), ">"],
  2782 +// ["<a href=\"",u,"\" style=\"",format(reverse(opt)),"\">"],
  2783 + javascript(s,h) then
  2784 + [s,"<a href=\"javascript: ",h,"\">"]
  2785 + },
  2786 + text,
  2787 + "</a>"
  2788 + ],
  2789 +
  2790 + push_button(options, text) then
  2791 + [
  2792 + if action is
  2793 + {
  2794 + url(u) then ["<a href=\"",u,"\"", format_coreattrs(options), ">",
  2795 + text, "</a>"
  2796 + ],
  2797 + javascript(s,h) then
  2798 + [s,"<INPUT TYPE =\"button\" Value=\"",text,"\"", format_coreattrs(options), " onClick=\"",h,"\">"]
  2799 + }
  2800 + ],
  2801 +
  2802 + button(url_off,url_on) then
  2803 + [ if action is
  2804 + {
  2805 + url(u) then ["<a href=\"",u],
  2806 + javascript(s,h) then [s,"<a onMouseDown=\"",h]
  2807 + },
  2808 + "\" style=\"text-decoration:none\">",
  2809 + "<img alt=\"",url_off,"\" src=\"",url_off,"\" border=0",
  2810 + " onMouseOver=\"this.src='",url_on,"'\" ",
  2811 + " onMouseOut=\"this.src='",url_off,"'\">",
  2812 + "</a>"
  2813 + ],
  2814 +
  2815 + button(url_off,url_on,w,h) then
  2816 + [ if action is
  2817 + {
  2818 + url(u) then ["<a href=\"",u],
  2819 + javascript(s,h) then [s,"<a onMouseDown=\"",h]
  2820 + },
  2821 + "\" style=\"text-decoration:none\">",
  2822 + "<img width=",w," height=",h," alt=\"",url_off,"\" src=\"",url_off,"\" border=0",
  2823 + " onMouseOver=\"this.src='",url_on,"'\" ",
  2824 + " onMouseOut=\"this.src='",url_off,"'\">",
  2825 + "</a>"
  2826 + ],
  2827 +
  2828 + immediate_selector(name,size,choices) then
  2829 + [ if action is
  2830 + {
  2831 + url(u) then ["<select href=\"",u]
  2832 + javascript(s,h) then [s,"<select onchange=\"",h]
  2833 + },
  2834 + "\" name=o",name," size=",size,">",
  2835 + format_choices(choices),"</select>"
  2836 + ]
  2837 + }.
  2838 +
  2839 +
  2840 +define Printable_tree
  2841 + format_local_popup_button
  2842 + (
  2843 + CommonInfo cinfo,
  2844 + Actioner_Aspect aspect,
  2845 + Int32 n,
  2846 + ) =
  2847 + if cinfo is info(common_name,http_port,https_port,site_dir,secret) then
  2848 + [ "<script type=\"text/javascript\" language=\"JavaScript\">",
  2849 + " var lpust_",n," = new Array(); ",
  2850 + " lpust_",n,"[0] = 0; ",
  2851 + "</script>",
  2852 + "<a href=\"javascript:show_local_popup('lpu_",n,"','lpust_",n,"');\">",
  2853 + if aspect is
  2854 + {
  2855 + link(opt,text) then [text],
  2856 + push_button(opt, text) then [text],
  2857 + button(url_off,url_on) then
  2858 + [
  2859 + "<img alt=\"",url_off,"\" src=\"",url_off,"\" border=0",
  2860 + " onMouseOver=\"this.src='",url_on,"'\" ",
  2861 + " onMouseOut=\"this.src='",url_off,"'\">",
  2862 + ],
  2863 +
  2864 + button(url_off,url_on,w,h) then
  2865 + [
  2866 + "<img width=",w," height=",h," alt=\"",url_off,"\" src=\"",url_off,"\" border=0",
  2867 + " onMouseOver=\"this.src='",url_on,"'\" ",
  2868 + " onMouseOut=\"this.src='",url_off,"'\">",
  2869 + ],
  2870 +
  2871 + immediate_selector(name,size,choices) then alert,
  2872 +
  2873 + },
  2874 + "</a>"].
  2875 +
  2876 +
  2877 +
  2878 +
  2879 +
  2880 + *** [5.5] Formating a private download link.
  2881 +
  2882 + We get the absolute path of the file to be downloaded, and the name under which it
  2883 + should appear to the client. The function 'format_private_download' creates an
  2884 + hypertext link for downloading the file. The secured mecanism of private download is
  2885 + used. This function is called by the function which formats HTML_Any($T) elements.
  2886 +
  2887 +
  2888 +define Printable_tree
  2889 + format_private_download
  2890 + (
  2891 + CommonInfo cinfo,
  2892 + String sn, // state name
  2893 + String abs_path, // absolute file path on server
  2894 + String name, // name of file as it appears in the browser
  2895 + String extra, // extra extension
  2896 + Maybe((String,List((String,String)))) action
  2897 +
  2898 + ) =
  2899 + if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
  2900 + with private_download_directory = site_directory+"/private_download",
  2901 + with auth = make_authorization(site_directory,secret,abs_path),
  2902 + [
  2903 + "<a href=\"",name,extra,"?zauth=",auth,
  2904 + if action is
  2905 + {
  2906 + failure then [ ]
  2907 + success(a) then if a is (an,args) then
  2908 + ["&amp;a=",an,format_extra_operands(args)]
  2909 + },
  2910 + "\">",
  2911 + name,
  2912 + "</a>"
  2913 + ].
  2914 +
  2915 +
  2916 +
  2917 +
  2918 + *** [5.6] Formating rows and cells in a table.
  2919 +
  2920 +define Int32
  2921 + percent
  2922 + (
  2923 + Int32 p
  2924 + ) =
  2925 + if p < 0 then 0 else if p > 100 then 100 else p.
  2926 +
  2927 +
  2928 +
  2929 +
  2930 + Formating cell options.
  2931 +
  2932 +
  2933 +
  2934 +define String
  2935 + format
  2936 + (
  2937 + BackgroundOption o
  2938 + ) =
  2939 + if o is
  2940 + {
  2941 + repeat then "",
  2942 + repeat_horizontal then "; background-repeat: repeat-x",
  2943 + repeat_vertical then "; background-repeat: repeat-y",
  2944 + no_repeat then "; background-repeat: no-repeat",
  2945 + center then "; background-position: center top"
  2946 + }.
  2947 +
  2948 +define String
  2949 + format
  2950 + (
  2951 + List(BackgroundOption) l
  2952 + ) =
  2953 + if l is
  2954 + {
  2955 + [ ] then "",
  2956 + [h . t] then format(h)+format(t)
  2957 + }.
  2958 +
  2959 +
  2960 +define String
  2961 + format
  2962 + (
  2963 + List(Cell_Option) options
  2964 + ) =
  2965 + if options is
  2966 + {
  2967 + [ ] then "",
  2968 + [h . t] then
  2969 + if h is
  2970 + {
  2971 + left then " align=left",
  2972 + h_center then " align=center",
  2973 + right then " align=right",
  2974 + top then " valign=top",
  2975 + v_center then " valign=middle",
  2976 + bottom then " valign=bottom",
  2977 + base_line then " valign=baseline",
  2978 + background_color(c) then " bgcolor=\""+html_format(c)+"\"",
  2979 + background_image(n,o) then " style=\"background: url("+n+")"+format(o)+"\"",
  2980 + width(w) then " width=\""+w+"\"",
  2981 + percentage_width(n) then " width=\""+percent(n)+"%\"",
  2982 + height(h) then " height="+h,
  2983 + columns(n) then " colspan="+n,
  2984 + rows(n) then " rowspan="+n,
  2985 + nowrap then " nowrap"
  2986 + }
  2987 + + format(t)
  2988 + }.
  2989 +
  2990 +
  2991 + Normalizing a list of cell options (horizontal position must be specified; the default
  2992 + is 'left').
  2993 +
  2994 +define List(Cell_Option)
  2995 + normalize
  2996 + (
  2997 + List(Cell_Option) l
  2998 + ) =
  2999 + if member(l,left) then l else
  3000 + if member(l,h_center) then l else
  3001 + if member(l,right) then l else
  3002 + [left . l].
  3003 +
  3004 +
  3005 + Formating cells in a row.
  3006 +
  3007 +define Printable_tree
  3008 + format
  3009 + (
  3010 + List(HTML_Cell($T)) cells,
  3011 + $T -> Printable_tree format_element
  3012 + ) =
  3013 + if cells is
  3014 + {
  3015 + [ ] then [ ],
  3016 + [h . t] then if h is cell(options,element) then
  3017 + ["<td ",format(reverse(normalize(options))),">",
  3018 + format_element(element),
  3019 + "</td>"
  3020 + . format(t,format_element)]
  3021 + }.
  3022 +
  3023 +
  3024 + Formating the rows in a table.
  3025 +
  3026 +define Printable_tree
  3027 + format
  3028 + (
  3029 + List(HTML_Row($T)) rows,
  3030 + $T -> Printable_tree format_element,
  3031 + ) =
  3032 + if rows is
  3033 + {
  3034 + [ ] then [ ],
  3035 + [h . t] then if h is row(options,cells) then
  3036 + ["<tr ",format(reverse(options)),">",
  3037 + format(cells,format_element),
  3038 + "</tr>"
  3039 + . format(t,format_element)]
  3040 + }.
  3041 +
  3042 +
  3043 +
  3044 +define Printable_tree
  3045 + format1
  3046 + (
  3047 + List(TextAreaOption) l
  3048 + ) =
  3049 + if l is
  3050 + {
  3051 + [] then [],
  3052 + [h . t] then if h is
  3053 + {
  3054 + disabled then [" disabled " . format1(t)]
  3055 + read_only then [" readonly " . format1(t)]
  3056 + wrap_lines then [" wrap " . format1(t)]
  3057 + }
  3058 + }.
  3059 +
  3060 +define Printable_tree
  3061 + format
  3062 + (
  3063 + List(TextAreaOption) l
  3064 + ) =
  3065 + if member(l,wrap_lines)
  3066 + then format1(l)
  3067 + else [" wrap=off " . format1(l)].
  3068 +
  3069 +
  3070 + *** [5.7] Formating elements which may be put anywhere.
  3071 +
  3072 + The function below involves the parameter $T which is later instantiated as
  3073 + 'HTML_In_Form' or as 'HTML_Off_Form'. Now, since there are dictinct 'format' functions
  3074 + for these two types, and because formating of tables requires recursive calls of such
  3075 + functions, it is necessary to provide the 'format' function to be called recursively as
  3076 + an argument. Putting naively a call to 'format' will not work, because the compiler
  3077 + will look for a function able to format data of type $T (which is at that time distinct
  3078 + from any other type, including our two types). Such a function does not exist. Hence
  3079 + the function to be called for formating elements must be passed as a functional
  3080 + argument (called 'format_element' below). Actually, what we pass is a function taking
  3081 + a unique argument of type $T. Other informations (like the name of the state) are
  3082 + already in the function by way of full functionality.
  3083 +
  3084 +
  3085 + Formating text options. They are formated in CSS syntax, to be used within a
  3086 + 'style=...'.
  3087 +
  3088 +define String
  3089 + format
  3090 + (
  3091 + List(Text_Option) l
  3092 + ) =
  3093 + if l is
  3094 + {
  3095 + [ ] then "",
  3096 + [h . t] then if h is
  3097 + {
  3098 + size(n) then "font-size:"+n+"pt",
  3099 + font(fn) then "font-family:"+fn,
  3100 + color(c) then if c is rgb(r,g,b) then
  3101 + "color:rgb("+word8_to_int32(r)+","+word8_to_int32(g)+","+word8_to_int32(b)+")",
  3102 + italic then "font-style:italic",
  3103 + oblique then "font-style:oblique",
  3104 + small_capitals then "font-variant:small-caps",
  3105 + bold then "font-weight:bold",
  3106 + underlined then "text-decoration:underline",
  3107 + left_justified then "text-align:left",
  3108 + right_justified then "text-align:right",
  3109 + justified then "text-align:justify",
  3110 + line_through then "text-decoration:line-through",
  3111 + nowrap then "white-space:nowrap",
  3112 + class(class_name)then " class=\"" +class_name +"\""
  3113 + } + if t is [ ] then "" else ("; "+format(t))
  3114 + }.
  3115 +
  3116 +
  3117 +
  3118 + Formating table options.
  3119 +
  3120 +define String
  3121 + format
  3122 + (
  3123 + List(Table_Option) l,
  3124 + Bool border_seen
  3125 + ) =
  3126 + if l is
  3127 + {
  3128 + [ ] then if border_seen then "" else " border=0 cellspacing=0 cellpadding=0",
  3129 + [h . t] then if h is
  3130 + {
  3131 + background_color(c) then " bgcolor=\""+html_format(c)+"\""+format(t,border_seen),
  3132 + background_image(url) then " background="+url+format(t,border_seen),
  3133 + border(o,top,i,c) then " border="+o+" cellspacing="+top+" cellpadding="+i+
  3134 + //" bordercolor="+format(c)+
  3135 + format(t,true),
  3136 + width(w) then " width=\""+w+"\""+format(t,border_seen),
  3137 + percentage_width(p) then " width=\""+percent(p)+"%\""+format(t,border_seen),
  3138 + }
  3139 + }.
  3140 +
  3141 +
  3142 +
  3143 +
  3144 +
  3145 +define Printable_tree
  3146 + format_scroller
  3147 + (
  3148 + String sn,
  3149 + Int32 width,
  3150 + Int32 height,
  3151 + Int32 content_width,
  3152 + Int32 content_height,
  3153 + Int32 idnum, // identifying the scroller
  3154 + $T content,
  3155 + $T -> Printable_tree format_element
  3156 + ) =
  3157 + [
  3158 + "<script type = \"text/javascript\" language=\"JavaScript\">",
  3159 + "function doscroll_",idnum,"(dx,dy) {\n",
  3160 + " if (document.layers) { var c_",idnum," = eval(document.cs_",idnum,"); } else\n",
  3161 + " if (document.getElementById) {var c_",idnum," = eval(\"document.getElementById('cs_",
  3162 + idnum,"').style\"); } else\n",
  3163 + " if (document.all) { var c_",idnum," = eval(document.all.cs_",idnum,".style); };\n",
  3164 + " var x_",idnum," = parseInt(c_",idnum,".left);\n",
  3165 + " var y_",idnum," = parseInt(c_",idnum,".top);\n",
  3166 + " if ((x_",idnum,"+dx <= 0) && (x_",idnum,"+dx > ",width-content_width,"))\n",
  3167 + " { x_",idnum," += dx; }\n",
  3168 + " if ((y_",idnum,"+dy <= 0) && (y_",idnum,"+dy > ",height-content_height,"))\n",
  3169 + " { y_",idnum," += dy; }\n",
  3170 + " c_",idnum,".left = x_",idnum,";\n",
  3171 + " c_",idnum,".top = y_",idnum,";\n",
  3172 + " }\n",
  3173 + "</script>",
  3174 + "<table>",
  3175 + "<tr>",
  3176 + "<td align=left valign=top",
  3177 + " width=",width,
  3178 + " height=",height,
  3179 + ">",
  3180 + "<div id=\"ws_",idnum,"\" style=\"position:absolute; width:",width,"px; height:",height,"px;",
  3181 + " clip:rect(0px ",width,"px ",height,"px 0px)\">",
  3182 + "<div id=\"cs_",idnum,"\" style=\"position:absolute; left:0px; top:0px\">",
  3183 + format_element(content),
  3184 + "</div>",
  3185 + "</div>",
  3186 + "</td>",
  3187 + "<td valign=bottom>",
  3188 + "<table>",
  3189 + "<tr><td><img alt=\"sroll up\" src=\"scrollup.gif\" onMouseDown=\"doscroll_",
  3190 + idnum,"(0,20);\"></td></tr>",
  3191 + "<tr><td><img alt=\"scroll down\" src=\"scrolldown.gif\" onMouseDown=\"doscroll_",
  3192 + idnum,"(0,-20);\"></td></tr>",
  3193 + "</table>",
  3194 + "</td>",
  3195 + "</tr>",
  3196 + (if content_width > width then
  3197 + [
  3198 + "<tr>",
  3199 + "<td align=right>",
  3200 + "<table>",
  3201 + "<tr>",
  3202 + "<td><img alt=\"scroll left\" src=\"scrollleft.gif\" onMouseDown=\"doscroll_",
  3203 + idnum,"(20,0);\"></td>",
  3204 + "<td><img alt=\"scroll right\" src=\"scrollright.gif\" onMouseDown=\"doscroll_",
  3205 + idnum,"(-20,0);\"></td>",
  3206 + "</tr>",
  3207 + "</table>",
  3208 + "</td>",
  3209 + "</tr>",
  3210 + ] else [ ]),
  3211 + "</table>"
  3212 + ].
  3213 +
  3214 +
  3215 +
  3216 + define Printable_tree
  3217 + popup_topbar
  3218 + (
  3219 + CommonInfo cinfo,
  3220 + String title,
  3221 + RGB color,
  3222 + Int32 width,
  3223 + ) =
  3224 + if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
  3225 + with xxxx = web_arg_encode(sha1((title,color,width))),
  3226 + path = site_directory+"/public/buttons/t"+xxxx+".jpg",
  3227 + result = (Printable_tree)["<img alt=\"button\" src=\"buttons/t"+xxxx+".jpg\">"],
  3228 + if file_exists(path) then result else
  3229 + with col = to_rgba(color),
  3230 + bg = create_button_background(col,width,20),
  3231 + very_light_color = lighten(col,70),
  3232 + dark_color = darken(col,40),
  3233 + title_width = printed_text_width(font,title),
  3234 + draw_button_text(bg,title,title_width,very_light_color,dark_color,font);
  3235 + forget(write_image_to_JPEG_file(to_JPEG(bg),path,100));
  3236 + result.
  3237 +
  3238 +
  3239 + define Printable_tree
  3240 + popup_close_button
  3241 + (
  3242 + CommonInfo cinfo,
  3243 + RGB color,
  3244 + String div_name,
  3245 + String state_var_name,
  3246 + ) =
  3247 + if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
  3248 + with xxxx = web_arg_encode(sha1(color)),
  3249 + path_on = site_directory+"/public/buttons/c"+xxxx+"_on.jpg",
  3250 + path_off = site_directory+"/public/buttons/c"+xxxx+"_off.jpg",
  3251 + result = (Printable_tree)["<img alt=\"button\" src=\"buttons/c"+xxxx+"_off.jpg\"",
  3252 + " onMouseOver=\"this.src='buttons/c"+xxxx+"_on.jpg'\"",
  3253 + " onMouseOut=\"this.src='buttons/c"+xxxx+"_off.jpg'\"",
  3254 + " onMouseDown=\"show_local_popup('",div_name,"','",state_var_name,"')\">"],
  3255 + if file_exists(path_on) then result else
  3256 + with col = to_rgba(color),
  3257 + title = "x",
  3258 + title_width = printed_text_width(font,title),
  3259 + bg_on = create_button_background(lighten(col,30),20,20),
  3260 + bg_off = create_button_background(col,20,20),
  3261 + very_light_color = lighten(col,70),
  3262 + dark_color = darken(col,40),
  3263 + draw_button_text(bg_on,title,title_width,very_light_color,dark_color,font);
  3264 + draw_button_text(bg_off,title,title_width,very_light_color,dark_color,font);
  3265 + forget(write_image_to_JPEG_file(to_JPEG(bg_on),path_on,100));
  3266 + forget(write_image_to_JPEG_file(to_JPEG(bg_off),path_off,100));
  3267 + result.
  3268 +
  3269 +
  3270 +
  3271 +
  3272 +
  3273 + // The function below formats a datum of type 'HTML_Any($T)'.
  3274 +
  3275 +define Printable_tree
  3276 + format
  3277 + (
  3278 + CommonInfo cinfo,
  3279 + String sn, // state_name
  3280 + Var(Int32) ic_v,
  3281 + HTML_Any($T) element,
  3282 + $T -> Printable_tree format_element, // able to format a datum of type $T
  3283 + Bool is_https,
  3284 + ) =
  3285 + if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
  3286 + if element is
  3287 + {
  3288 + any_text(opts,t) then
  3289 + ["<span ", format_text_options(opts), ">",t,"</span>"],
  3290 + any_preformated(opts,s) then
  3291 + ["<span ", format_text_options(opts), "><pre>",s,"</pre></span>"],
  3292 + //["<pre>",s,"</pre>"],
  3293 + any_paragraph(opts,t) then
  3294 + ["<p ", format_text_options(opts), ">",t,"</p>"],
  3295 + any_image(url) then
  3296 + ["<img alt=\"",url,"\" src=\"",url,"\">"],
  3297 + any_image(url,w,h) then
  3298 + ["<img alt=\"",url,"\" src=\"",url,"\" width=",w," height=",h,">"],
  3299 + any_table(opts,rows) then
  3300 + ["<table ",format(reverse(opts),false),">",format(rows,format_element),"</table>"],
  3301 + any_center(e) then
  3302 + ["<center>",format_element(e),"</center>"],
  3303 + any_mail_to(email,elem) then
  3304 + ["<a href=\"mailto:",email,"\">",format_element(elem),"</a>"],
  3305 + any_scroller(w,h,cw,ch,c) then
  3306 + format_scroller(sn,w,h,cw,ch,new_idnum(ic_v),c,format_element),
  3307 + any_fixed_size(w,h,c) then
  3308 + with url = create_secondary_document(site_directory,secret,sn,format_element,c,w),
  3309 + ["<object data=\"",url,"\" type=\"text/html\" width=",format(w)," height=",format(h)," >",
  3310 + "secondary document",
  3311 + "</object>"],
  3312 + any_fixed_size_2(w,h,fn) then
  3313 + with url = fn+"?zauth="+make_authorization(site_directory,secret,
  3314 + fn),
  3315 + ["<object data=\"",url,"\" type=\"text/html\" width=",format(w)," height=",format(h)," >",
  3316 + "secondary document",
  3317 + "</object>"],
  3318 + any_actioner(c,t,a,an,eo,ja,fn) then
  3319 + format_actioner(cinfo,sn,c,t,a,an,eo,ja,fn,is_https),
  3320 + any_foreign_link(options,url,name) then
  3321 + ["<a href=\"",url,"\"><span ", format_text_options(options), ">",name,"</span></a>"],
  3322 + any_private_download(url,name,extra_ext,action) then
  3323 + format_private_download(cinfo,sn,url,name,extra_ext,action),
  3324 + any_div(options, e) then
  3325 + [format_div_option(options), format_element(e),"</DIV>"],
  3326 + any_div_empty(options) then
  3327 + [format_div_option(options), "</DIV>"],
  3328 + any_coreattrs(attributs) then
  3329 + [format_coreattrs(attributs)]
  3330 + }.
  3331 +
  3332 +
  3333 +
  3334 +
  3335 + // *** [5.8] Formating 'in form' elements.
  3336 +
  3337 +
  3338 +
  3339 +
  3340 +
  3341 +define Printable_tree
  3342 + format
  3343 + (
  3344 + CommonInfo cinfo,
  3345 + String fn, // form_name
  3346 + String sn, // state_name
  3347 + Var(Int32) ic_v, // idnum counter variable
  3348 + HTML_In_Form element,
  3349 + Bool is_https,
  3350 + ) =
  3351 + if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
  3352 + with format_element = (HTML_In_Form e) |-> format(cinfo,fn,sn,ic_v,e,is_https),
  3353 + if element is
  3354 + {
  3355 + literal_pt(t) then t,
  3356 + literal(t) then [t],
  3357 + sequence(l) then flat(map(format_element,l))
  3358 + text(opts,t) then
  3359 + format(cinfo,sn,ic_v,any_text(opts,t),format_element,is_https),
  3360 + preformated(o,s) then
  3361 + format(cinfo,sn,ic_v,any_preformated(o,s),format_element,is_https),
  3362 + paragraph(opts,t) then
  3363 + format(cinfo,sn,ic_v,any_paragraph(opts,t),format_element,is_https),
  3364 + image(url) then
  3365 + format(cinfo,sn,ic_v,any_image(url),format_element,is_https),
  3366 + image(url,w,h) then
  3367 + format(cinfo,sn,ic_v,any_image(url,w,h),format_element,is_https),
  3368 + table(opts,rows) then
  3369 + format(cinfo,sn,ic_v,any_table(opts,rows),format_element,is_https),
  3370 + center(e) then
  3371 + format(cinfo,sn,ic_v,any_center(e),format_element,is_https),
  3372 + mail_to(a,e) then
  3373 + format(cinfo,sn,ic_v,any_mail_to(a,e),format_element,is_https),
  3374 + scroller(w,h,cw,ch,c) then
  3375 + format(cinfo,sn,ic_v,any_scroller(w,h,cw,ch,c),format_element,is_https),
  3376 + actioner(c,t,a,an,eo,ja) then
  3377 + format(cinfo,sn,ic_v,any_actioner(c,t,a,an,eo,ja,success(fn)),format_element,is_https),
  3378 + foreign_link(options,url,name) then
  3379 + format(cinfo,sn,ic_v,any_foreign_link(options,url,name),format_element,is_https),
  3380 + private_download(url,name,extra,action) then
  3381 + format(cinfo,sn,ic_v,any_private_download(url,name,extra,action),format_element,is_https),
  3382 + text_input(label_text, label, name,i,w) then
  3383 + [ "<label for=\"",label,"\">",label_text,"</label>",
  3384 + "<input type=text name=o",name," id=",label," size=",w," value=\"",i,"\">"],
  3385 + //["&nbsp; <input type=text name=o",n," size=",w," value=\"",i,"\">"],
  3386 + password_input(label_text, label, name,w) then
  3387 + [ "<label for=\"",label,"\">",label_text,"</label>",
  3388 + "<input type=password name=p",name," id=",label," size=",w,">"],
  3389 + //["&nbsp; <input type=password name=p",n," size=",w,">"],
  3390 + text_area(opts,n,i,w,h) then
  3391 + ["<textarea ",format(opts)," name=o",n," cols=",w," rows=",h,">",i,"</textarea>"],
  3392 + file_upload(n,w) then
  3393 + ["<input type=file size=",w," name=o",n,">"],
  3394 + selector(n,s,cs) then
  3395 + ["<select name=o",n," size=",s,">",format_choices(cs),"</select>"],
  3396 + selector(n,s,cs,sd) then
  3397 + ["<select name=o",n," size=",s,">",format_choices(cs,sd),"</select>"],
  3398 + selector_c(n,s,cs) then
  3399 + ["<select name=o",n," size=",s,">",format_choices(cs),"</select>"],
  3400 + selector_c(n,s,cs,sd) then
  3401 + ["<select name=o",n," size=",s,">",format_choices(cs,sd),"</select>"],
  3402 +
  3403 + radio_button(label_text,label,n,v,c) then
  3404 + [ "<label for=\"",label,"\">",label_text,"</label>",
  3405 + "<input type=radio name=o",n," id=",label," value=\"",v,"\"",(if c then " checked" else ""),">"],
  3406 + check_box(label_text, label,n,c) then
  3407 + [ "<label for=\"",label,"\">",label_text,"</label>",
  3408 + "<input type=checkbox name=o",n," id=\"",label,"\""+(if c then " checked " else ""),">"]
  3409 + div(options, e) then
  3410 + format(cinfo,sn,ic_v,any_div(options, e),format_element,is_https),
  3411 + div_empty(options) then
  3412 + format(cinfo,sn,ic_v,any_div_empty(options),format_element,is_https),
  3413 + hidden(name, value) then
  3414 + ["<input type=hidden name=o",name," value=\"",value,"\">"],
  3415 +
  3416 + }.
  3417 +
  3418 +
  3419 +
  3420 +
  3421 +
  3422 +
  3423 + *** [5.9] Formating 'off form' elements.
  3424 +
  3425 + The encryption type 'multipart/form-data' is required for a form containing an upload.
  3426 +
  3427 +
  3428 +define Bool
  3429 + contains_an_upload
  3430 + (
  3431 + HTML_In_Form form_content
  3432 + ).
  3433 +
  3434 +define Bool
  3435 + contains_an_upload
  3436 + (
  3437 + HTML_Row(HTML_In_Form) row
  3438 + ) =
  3439 + mapor(contains_an_upload,
  3440 + map(content,cells(row))).
  3441 +
  3442 +
  3443 +define Bool
  3444 + contains_an_upload
  3445 + (
  3446 + HTML_In_Form form_content
  3447 + ) =
  3448 + if form_content is
  3449 + {
  3450 + literal_pt(t) then false,
  3451 + literal(t) then false,
  3452 + sequence(l) then mapor(contains_an_upload,l)
  3453 + text(o,t) then false,
  3454 + preformated(o,s) then false,
  3455 + paragraph(o,t) then false,
  3456 + image(u) then false,
  3457 + image(u,w,h) then false,
  3458 + table(o,rows) then mapor(contains_an_upload,rows),
  3459 + center(e) then contains_an_upload(e),
  3460 + mail_to(m,e) then false, // 'e' may but should not contain an upload
  3461 + scroller(w,h,cw,ch,e) then contains_an_upload(e),
  3462 + actioner(c,t,a,an,eo,ja) then false,
  3463 + foreign_link(o,u,n) then false,
  3464 + private_download(p,n,e,a) then false,
  3465 + text_input(lt,l,n,i,w) then false,
  3466 + password_input(lt,l,n,w) then false,
  3467 + text_area(o,n,i,w,h) then false,
  3468 + file_upload(n,w) then true,
  3469 + selector(n,s,c) then false,
  3470 + selector(n,s,c,p) then false,
  3471 + selector_c(n,s,c) then false,
  3472 + selector_c(n,s,c,p) then false,
  3473 + radio_button(_,_,n,v,c) then false,
  3474 + check_box(_,_,n,c) then false,
  3475 + div(o,c) then false,
  3476 + div_empty(o) then false,
  3477 + hidden(_,_) then false
  3478 + }.
  3479 +
  3480 +define String
  3481 + enctype
  3482 + (
  3483 + HTML_In_Form form_content
  3484 + ) =
  3485 + if contains_an_upload(form_content)
  3486 + then " enctype=multipart/form-data"
  3487 + else "".
  3488 +
  3489 +
  3490 +
  3491 +define Printable_tree
  3492 + format
  3493 + (
  3494 + CommonInfo cinfo,
  3495 + String sn, // state_name
  3496 + Var(Int32) ic_v, // 'idnum' counter variable
  3497 + HTML_Off_Form element,
  3498 + Bool is_https,
  3499 + ) =
  3500 + if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
  3501 + with format_element = (HTML_Off_Form e) |-> format(cinfo,sn,ic_v,e,is_https),
  3502 + if element is
  3503 + {
  3504 + literal_pt(t) then t,
  3505 + literal(t) then [t],
  3506 + sequence(l) then flat(map(format_element,l)),
  3507 + text(opts,t) then
  3508 + format(cinfo,sn,ic_v,any_text(opts,t),format_element,is_https),
  3509 + preformated(o,s) then
  3510 + format(cinfo,sn,ic_v,any_preformated(o,s),format_element,is_https),
  3511 + paragraph(opts,t) then
  3512 + format(cinfo,sn,ic_v,any_paragraph(opts,t),format_element,is_https),
  3513 + image(url) then
  3514 + format(cinfo,sn,ic_v,any_image(url),format_element,is_https),
  3515 + image(url,w,h) then
  3516 + format(cinfo,sn,ic_v,any_image(url,w,h),format_element,is_https),
  3517 + table(opts,rows) then
  3518 + format(cinfo,sn,ic_v,any_table(opts,rows),format_element,is_https),
  3519 + center(e) then
  3520 + format(cinfo,sn,ic_v,any_center(e),format_element,is_https),
  3521 + mail_to(a,e) then
  3522 + format(cinfo,sn,ic_v,any_mail_to(a,e),format_element,is_https),
  3523 + scroller(w,h,cw,ch,c) then
  3524 + format(cinfo,sn,ic_v,any_scroller(w,h,cw,ch,c),format_element,is_https),
  3525 + fixed_size(w,h,c) then
  3526 + format(cinfo,sn,ic_v,any_fixed_size(w,h,c),format_element,is_https),
  3527 + fixed_size_2(w,h,fn) then
  3528 + format(cinfo,sn,ic_v,any_fixed_size_2(w,h,fn),format_element,is_https),
  3529 + actioner(c,t,a,an,eo,ja) then
  3530 + format(cinfo,sn,ic_v,any_actioner(c,t,a,an,eo,ja,failure),format_element,is_https),
  3531 + actioner(c,t,a,an,eo,ja,fn) then
  3532 + format(cinfo,sn,ic_v,any_actioner(c,t,a,an,eo,ja,success(fn)),format_element,is_https),
  3533 + foreign_link(options,url,name) then
  3534 + format(cinfo,sn,ic_v,any_foreign_link(options,url,name),format_element,is_https),
  3535 + private_download(url,name,extra,action) then
  3536 + format(cinfo,sn,ic_v,any_private_download(url,name,extra,action),format_element,is_https),
  3537 + label(n) then ["<a name=\"",n,"\">"],
  3538 + form(fn,attributs, c) then
  3539 + [
  3540 + "<form name=\"f",fn,"\"",
  3541 + format(cinfo,sn,ic_v,any_coreattrs(attributs),format_element,is_https),
  3542 + " method=POST",
  3543 + enctype(c),
  3544 + " action=\"http",
  3545 + if is_https then "s" else "",
  3546 + "://",common_name,":",http_port,"/\">",
  3547 + // action is set dynamically by
  3548 + // the actioner using JavaScript
  3549 + format(cinfo,fn,sn,ic_v,c,is_https),
  3550 + "</form>"
  3551 + ]
  3552 + div(options, e) then
  3553 + format(cinfo,sn,ic_v,any_div(options, e),format_element,is_https),
  3554 + div_empty(options) then
  3555 + format(cinfo,sn,ic_v,any_div_empty(options),format_element,is_https),
  3556 +
  3557 + }.
  3558 +
  3559 +
  3560 +
  3561 +
  3562 + *** [5.10] Formating meta-tags.
  3563 +
  3564 +define Printable_tree
  3565 + format_keywords
  3566 + (
  3567 + List(String) l
  3568 + ) =
  3569 + if l is
  3570 + {
  3571 + [] then [ ],
  3572 + [h . t] then if t is []
  3573 + then [h]
  3574 + else [h , ", " . format_keywords(t)]
  3575 + }.
  3576 +
  3577 +
  3578 +define Printable_tree
  3579 + format
  3580 + (
  3581 + CommonInfo cinfo,
  3582 + String state_name,
  3583 + HTML_Meta m,
  3584 + Bool is_https
  3585 + ) =
  3586 + if m is
  3587 + {
  3588 + keywords(l) then ["<meta name=\"keywords\" content=\"",format_keywords(l),"\">"],
  3589 + refresh(co,ta,an,delay) then
  3590 + ["<meta http-equiv=\"Refresh\" content=\"",delay,"; URL=",
  3591 + make_actioner_url(cinfo,co,ta,state_name,an,[],is_https),"\">"],
  3592 + meta(n,c) then ["<meta name=\"",n,"\" content=\"",c,"\">"],
  3593 + http_equiv(n,c) then ["<meta http-equiv=\"",n,"\" content=\"",c,"\">"],
  3594 + generic_meta(l) then ["<meta ",
  3595 + flat(map(((String,String) p) |-> if p is (n,v) then [n,"=\"",v,"\" "],
  3596 + l)),
  3597 + ">"],
  3598 + literal(s) then [s]
  3599 + }.
  3600 +
  3601 +
  3602 +define Printable_tree
  3603 + format
  3604 + (
  3605 + CommonInfo cinfo,
  3606 + String state_name,
  3607 + List(HTML_Meta) metas,
  3608 + Bool is_https,
  3609 + String charset
  3610 + ) =
  3611 + if metas is
  3612 + {
  3613 + [] then [format(cinfo,state_name,http_equiv("content-type",
  3614 + "text/html; charset="+charset),is_https)],
  3615 + [h . t] then [format(cinfo,state_name,h,is_https)
  3616 + . format(cinfo,state_name,t,is_https,charset)]
  3617 + }.
  3618 +
  3619 +
  3620 +define Printable_tree
  3621 + format
  3622 + (
  3623 + Body_Option o
  3624 + ) =
  3625 + if o is
  3626 + {
  3627 + background_color(c) then [" bgcolor=\"" , (String)html_format(c), "\""],
  3628 + background_image(n) then [" background=", n],
  3629 + background_image(n,o) then [" style=\"background: url(",n,")",format(o),"\""]
  3630 +
  3631 + }.
  3632 +
  3633 +
  3634 +
  3635 +define Printable_tree
  3636 + format
  3637 + (
  3638 + List(Body_Option) l
  3639 + ) =
  3640 + if l is
  3641 + {
  3642 + [ ] then [ ],
  3643 + [h . t] then [format(h) . format(t)]
  3644 + }.
  3645 +
  3646 +define Printable_tree
  3647 + add_css_files
  3648 + (
  3649 + List(CSS_File) l
  3650 + ) =
  3651 + if l is
  3652 + {
  3653 + [ ] then [ ],
  3654 + [h . t] then
  3655 + [ ["<LINK rel=\"stylesheet\" type=\"text/css\" href=" + file_name(h) + ">\n" ]
  3656 + . add_css_files(t)]
  3657 + }.
  3658 +
  3659 +define Printable_tree
  3660 + add_css_styles
  3661 + (
  3662 + List(CSS_Style) css_styles
  3663 + ) =
  3664 +
  3665 + if css_styles is
  3666 + {
  3667 + [] then [],
  3668 + [_._] then [ "<style type=\"text/css\"><!--\n",
  3669 + format_css_styles(css_styles),
  3670 + " --></style>"
  3671 + ]
  3672 + }.
  3673 +
  3674 +define Printable_tree
  3675 + format
  3676 + (
  3677 + CommonInfo cinfo,
  3678 + String state_name,
  3679 + HTML_Page page,
  3680 + Bool is_https,
  3681 + String charset
  3682 + ) =
  3683 + if cinfo is info(common_name,http_port,https_port,site_directory,secret) then
  3684 + with ic_v = var((Int32)0),
  3685 + if page is
  3686 + {
  3687 + html_page(title,metas,css_styles, css_files, body) then
  3688 + if body is body(options,element) then
  3689 + [ doctype_w3c_header,
  3690 + "<html>",
  3691 + "<head>",
  3692 + add_css_styles(css_styles),
  3693 + add_css_files(css_files),
  3694 + "<link rel=\"shortcut icon\" href=\"favicon.ico\">",
  3695 + "<script type = \"text/javascript\" language=\"JavaScript\">",
  3696 + " function show_local_popup(divname,stvname) {",
  3697 + " if (document.layers) { var d = eval(document.divname); } else\n",
  3698 + " if (document.getElementById) { var d = eval(\"document.getElementById(divname)\"); } else\n",
  3699 + " if (document.all) { var d = eval(document.all.divname.style)};\n",
  3700 + // " alert(typeof(eval(stvname))); ",
  3701 + " var s = eval(stvname); ",
  3702 + " if (s[0]==0) ",
  3703 + " { s[0]=1; d.style.visibility = 'visible'; d.zIndex = 100; } else\n",
  3704 + " { s[0]=0; d.style.visibility = 'hidden'; }; }",
  3705 + "</script>",
  3706 + "<title>",title,"</title>", // put title
  3707 + format(cinfo,state_name,metas,is_https,charset), // format the metas
  3708 + "</head>",
  3709 + "<body ", format(options), ">", // format body options
  3710 + //"<center>",
  3711 + format(cinfo,state_name,ic_v,element,is_https),
  3712 + //"</center>",
  3713 + "</body>",
  3714 + "</html>"
  3715 + ]
  3716 + }.
  3717 +
  3718 +
  3719 +
  3720 +
  3721 +
  3722 +
... ...
calexium_lib/web/CXM_multihost_http_server.anubis
  Show/Hide comments   View file @38d4c6f
Changes suppressed. Click to show
1   -
2   - *Project* The Anubis Project
3   -
4   - *Title* A Multi Host HTTP/HTTPS Server
5   -
6   - *Copyright* Copyright (c) Alain Prouté 2003.
7   -
8   -
9   - *Author* Alain Prouté
10   -
11   -
12   - *Revised* August 2005.
13   -
14   -
15   -
16   - *Overviews*
17   - In this file a HTTP/HTTPS server is defined, which is able to handle multiple hosts
18   - (virtual hosts). It answers HTTP/HTTPS requests, sends files (images or any other kind
19   - of file), constructs HTML pages on the fly using informations received from the client
20   - (when the URI ends by '.awp'), handles uploading of files and redirections. It is
21   - multitasking by itself, and can handle any number of sites and clients simultaneously.
22   - It should better be used in conjunction with 'making_a_web_site.anubis' to be found in
23   - the same directory. If you use 'web/making_a_web_site.anubis', you don't need to read
24   - this file.
25   -
26   -
27   - ----------------------------------- Table of Contents ---------------------------------
28   -
29   - *** (1) Multihosting and redirections.
30   - *** (2) The incompatibility between SSL and virtual hosts.
31   - *** (3) HTTP headers and web arguments.
32   - *** (4) Site descriptions.
33   - *** (5) Protection against denial of service attacks.
34   - *** (6) Starting your HTTP and HTTPS servers.
35   - *** (7) Private download.
36   - *** (8) About web argument names.
37   - *** (9) A web dispatcher.
38   -
39   - ---------------------------------------------------------------------------------------
40   -
41   -
42   -
43   -
44   - *** (1) Multihosting and redirections.
45   -
46   - This HTTP/HTTPS server can handle several host (also called 'virtual hosts'), in other
47   - words, you may have several sites on the same server, with the same IP address and same
48   - port numbers, but distinct 'host names'.
49   -
50   - A HTTP request sent by a browser contains the following informations:
51   -
52   - - a 'host name',
53   - - an URI (Uniform Resource Identifier),
54   - - HTTP headers,
55   - - web arguments (in the form 'name=value').
56   -
57   - Actually, the host name is just the value of the HTTP header whose name is 'Host'. The
58   - host name indicates which site is requested. Hence, it is the primary information for
59   - branching to the right site. If there is no 'Host' HTTP header in the request, the
60   - request is denied.
61   -
62   - From now on, we may assume that the host is determined, and consequently that we are
63   - concerned by only one site. Each site has his own directories on the server's
64   - disk.
65   -
66   - Each site also has a list of 'redirections'. A redirection is a triplet, like this one:
67   -
68   - redirect("/", "www.our-business.com", "/homepage.awp")
69   -
70   - meaning that if the host is "www.our-business.com", and if the requested URI is "/",
71   - then the URI to be served is "/homepage.awp". 'redirect' is a constructor of the type
72   - 'Redirection' defined in 'web/common.anubis'.
73   -
74   - Now, an URI may end by ".awp" (meaning 'Anubis Web Page') or not. If it does, the
75   - server understands that an HTML page must be constructed on the fly, and to that end it
76   - calls the 'awp handler' of the site. Otherwise, the URI must end by a known extension,
77   - like ".jpg", ".png", ".txt", etc... and represents a file path relative to the
78   - 'public' directory of the site. If these conditions are satisfied, the file is sent to
79   - the client. Known extensions are recorded in 'web/mime.anubis'.
80   -
81   -
82   -
83   -
84   - *** (2) The incompatibility between SSL and virtual hosts.
85   -
86   - Handling virtual hosts makes a problem under SSL (i.e. when using HTTPS), which is due
87   - to the fact that the guys at Netscape who designed SSL probably did not have the
88   - question of virtual hosts in mind. Indeed, the SSL handshake is completed before the
89   - server can know about the value of the 'Host' HTTP header, so that it cannot know which
90   - server certificate must be sent to the client. This makes a problem, because the
91   - browser will not accept a certificate whose common name does not correspond to the name
92   - of the requested host. The user will have to accept the certificate manually, which is
93   - not good for the security image of the site. This problem has at least two solutions
94   - (as far as Anubis is concerned).
95   -
96   - Solution 1. Arrange so that the network interface on which the server is listening
97   - has at least as many different IP addresses as you have virtual hosts. Such
98   - supplementary IP addresses are called 'IP Aliases'. In this case, start one HTTPS
99   - server for each virtual host, each one listening on a different address. For the time
100   - being, this method is applicable under Anubis only if you start as many instances of
101   - 'anbexec' as you have virtual hosts, because each instance of 'anbexec' can handle only
102   - one server certificate. Of course, getting IP aliases is another problem to be solved
103   - with your Internet provider.
104   -
105   - Solution 2. We propose a simple solution, using only one server certificate (hence
106   - only one instance of 'anbexec'). Since, we have only one server certificate, we must
107   - introduce a notion of 'main host', i.e. a host containing all other 'virtual
108   - hosts'. The unique server certificate belong to the main host, so that only the main
109   - host is identified by the client. The client must trust the main host and be confident
110   - that the main host redirects him to the right virtual host. Actually, the process will
111   - be transparent to the client, except that the client will see the name of the main host
112   - instead of the name of the virtual host in the 'location' field of the browser.
113   -
114   - So, assume that the name of main host is 'www.securedhost.com', and that the names of
115   - the virtual hosts are:
116   -
117   - actual name simplified name
118   - -----------------------------------------------------
119   - www.virtual1.com virtual1
120   - www.virtual2.com virtual2
121   - www.virtual3.com virtual3
122   -
123   - Then the (confidential) document '/doc/my_document.pdf' on 'www.virtual2.com' will have
124   - the URL:
125   -
126   - https://www.securedhost.com/virtual2/doc/my_document.pdf
127   -
128   - In order to work transparently, this solution must combine HTTP and HTTPS. Indeed, the
129   - vitual host must have a first page reachable under HTTP, through the URL:
130   -
131   - http://www.virtual2.com/
132   -
133   - The HTTP server will redirect this URL to the awp handler of virtual host 'virtual2'.
134   - The handler of this virtual host is able to generate a first page containing the
135   - following HTML meta:
136   -
137   - <meta http-equiv="Refresh" content="0;URL=https://www.securedhost.com/virtual2/">,
138   -
139   - so that the client is immediately redirected to the main host under HTTPS (hence
140   - accepting tranparently the server certificate). The awp handler of 'virtual2' then
141   - redirects this URL to the home page (maybe a login page) of 'virtual2'.
142   -
143   - See 'web/making_a_web_site.anubis' for the sequel of this story.
144   -
145   -
146   -
147   -
148   -
149   - *** (3) HTTP headers and web arguments.
150   -
151   - Each HTTP request which arrives on the server contains a request line followed by a
152   - series of HTTP headers. Each HTTP header is a pair '(name,value)' assigning a value to
153   - a name. The type 'HTTP_header' is defined in 'web/common.anubis'.
154   -
155   - The request may also have a 'body'. The body contains either 'web arguments' or
156   - uploaded files (or both). The request line itself may also contain web arguments (in a
157   - so-called 'query string'). Like HTTP headers, 'web arguments' are pairs
158   - '(name,value)', but the difference is that these pairs are generated by the page within
159   - which the client clicks, while HTTP headers are generated by the browser itself. The
160   - type 'Web_arg' is defined in 'web/common.anubis'. It has two alternatives, one for
161   - ordinary web arguments (pairs) and one for uploaded files.
162   -
163   -read CXM_common.anubis
164   -read tools/basis.anubis
165   -read CXM_mime.anubis
166   -
167   -
168   -
169   - *** (4) Site descriptions.
170   -
171   - The type HTTP_Info gathers informations comming along with the client's request. These
172   - informations are rarely used for composing HTML pages. Nevertheless, they are at your
173   - disposal.
174   -
175   -public type HTTP_Info:
176   - http_info
177   - (
178   - Int32 ip_address, // IP address of the client
179   - String uri, // URI requested by the client
180   - List(HTTP_header) http_headers, // HTTP headers sent by the client
181   - One -> String generate_trust_ticket // may be used against denial of
182   - // service attacks
183   - ).
184   -
185   -
186   -
187   - Each site is described by a 'web site description', which is a datum of type
188   - 'Web_Site_Description'.
189   -
190   -public type Web_Site_Description:
191   - web_site_description(
192   - List(String) common_names,
193   - String site_directory,
194   - List(Redirection) redirections,
195   - String charset,
196   - List(String) journal_extensions,
197   - List(String) journal_headers,
198   - String authorization_secret,
199   - List(MIME) known_mime_types,
200   - (String host_name,
201   - HTTP_Info http_info,
202   - List(Web_arg) lwa,
203   - Bool is_https) -> (List(HTTP_header),
204   - Printable_tree) awp_handler,
205   - (List(Web_arg) lwa) -> One before_send_file).
206   -
207   - The component 'common_names' is the list of names of the site, like for example
208   - "www.our-business.com". The reason why we have a list of common names instead of a
209   - single common name, is that it may be useful to have a common name like "192.168.0.1"
210   - for testing.
211   -
212   - 'charset' is a string which will determine the character encoding to be used by the
213   - browser. Typically, this string is one of: "UTF-8", "ISO-8859-1", "Windows-1252",
214   - etc...
215   -
216   - 'journal_extensions' is the list of URI extensions for which you want a log in the
217   - journal (and on the console). When a request arrives, and if the extension is a member
218   - of this list, a message is printed into the journal of the site including the date, the
219   - IP address of the client, the complete HTTP request line. The HTTP headers whose name
220   - is a member of 'journal_headers' are also printed in the journal. A reasonable minimum
221   - for these two components is:
222   -
223   - [".awp"] for journal_extensions
224   - ["user-agent"] for journal_headers
225   -
226   - 'authorization_secret' is a string which should just be unguessable. You may choose
227   - something like (but don't choose this one !):
228   -
229   - "Hg8kJe42gCML9jNH-74"
230   -
231   - i.e. a sequence of characters typed at random, long enough to be unguessable. This is
232   - used by the 'private download' mecanism, which is discussed later in this file.
233   -
234   - The component 'awp_handler' is a function of type:
235   -
236   - (String host_name,
237   - HTTP_Info http_info,
238   - List(Web_arg) web_args,
239   - Bool is_https) -> Printable_tree
240   -
241   - ('Printable_tree' is a substitute for 'String' and is defined in
242   - 'tools/basis.anubis'). This function is the 'awp handler' for the site. When the URI
243   - ends by ".awp", this function is called, and the result (an HTML page) is sent to the
244   - client over the connection. The last operand to this function is a boolean which is
245   - 'true' when the requests arrives through the HTTPS channel, and 'false' when it arrives
246   - through the HTTP channel.
247   -
248   -
249   -
250   -
251   -
252   -
253   -
254   - *** (5) Protection against denial of service attacks.
255   -
256   - We need to protect our servers against 'denial of service' attacks. The attack may be
257   - send automatically from machines which are infested by viruses. In that case, our
258   - server is saturated of connections (all virtual machines at work), but nothing is
259   - comming on the connections. In order to avoid this problem, we propose the following:
260   -
261   - (1) Limit the number of simultaneous connections (say to 100).
262   - (2) Close a connection if the request is not complete after say 10 seconds.
263   - (3) Close the connection if the request is bigger than a given size (normal requests
264   - are small except when there are uploaded files.
265   - (4) Close the connection during the sending of the answer if the client is waiting
266   - too much.
267   - (5) Record all IP addresses with which we have encountered one of the problems above.
268   - (6) Immediately close the connections if the IP address is in our list.
269   - (7) Remove an address from the list only after 5 minutes of inactivity of this
270   - address.
271   - (8) Maintain a list of reliable IP addresses.
272   -
273   - Of course, all the above are approximative solutions which may in some circumstances
274   - become either cumbersome or also partially block the system. So, it is needed to have a
275   - set of dynamically modifiable parameters in order to master the behavior of this
276   - mecanism.
277   -
278   -
279   - Each dubious IP address is recorded together with its last activity time.
280   -
281   -public type DubiousIP:
282   - dubious_ip (Int32 address,
283   - Int32 last_activity).
284   -
285   -
286   -public type DenialOfService:
287   - denial_of_service(Var(Int32) max_connections,
288   - Var(Int32) request_line_delay, // seconds
289   - Var(Int32) headers_delay,
290   - Var(Int32) answer_delay,
291   - Var(List(DubiousIP)) list_of_dubious,
292   - Var(List(Int32)) reliable_addresses).
293   -
294   - The informations in this set of variables are stored serialized into the file
295   - 'my_anubis/web_sites/dos_info'. If this file does not exist a set if variables with
296   - default values is created. The values are saved on the disk each time they are
297   - modified.
298   -
299   -public define DenialOfService load_denial_of_service_info.
300   -
301   -
302   -
303   - *** (6) Starting your HTTP and HTTPS servers.
304   -
305   - When your web site descriptions are ready, you can start a pair of servers (a HTTP
306   - server and a HTTPS server) for serving your web sites. Notice that there are always
307   - two servers, regardless of the number of web sites, and that each web sites normally
308   - uses the two servers.
309   -
310   -
311   -public define StartServerResult
312   - start_http_server
313   - (
314   - Int32 ip_address,
315   - Int32 http_port,
316   - List(Web_Site_Description) web_sites,
317   - DenialOfService dos
318   - ).
319   -
320   -public define StartServerResult
321   - start_https_server
322   - (
323   - Int32 ip_address,
324   - Int32 https_port,
325   - String certificate_common_name,
326   - List(Web_Site_Description) web_sites,
327   - DenialOfService dos
328   - ).
329   -
330   - The first argument 'ip_address' is the IP address on which the servers listen. If you
331   - put 0, the servers listen on all adresses of the machine (which is useful if the
332   - machine has several network interfaces). Otherwise, use the function 'ip_address'
333   - defined in 'tools/basis.anubis' for composing a particular IP address.
334   -
335   - The next arguments are the port numbers for HTTP and HTTPS. The usual values are 80 and
336   - 443, but you may have reasons to choose other values.
337   -
338   - The next argument is the list of your web site descriptions. All the sites described in
339   - this list will be accessible on the server.
340   -
341   - The argument 'dos' is a set of dynamic variables containing the informations for
342   - protecting the servers against denial of service attacks.
343   -
344   -
345   -
346   -
347   -
348   -
349   - *** (7) Private download.
350   -
351   - It may happen that you want to propose private files for download. This means that such
352   - a file could be downloaded only by the authorized person, and should not be seen by any
353   - other one. This feature can be used only under HTTPS, not under HTTP.
354   -
355   - The file may be located anywhere on the server. Hence, the file has a complete absolute
356   - path, like for example:
357   -
358   - /home/georges/my_documents/my_text.pdf
359   -
360   - which has nothing to do with the directories of the web server. Now, you may also want
361   - to show another path or simply just a name to the client, not the actual absolute path
362   - above, which may need to remain secret. So for example, the same file may appear to the
363   - client as:
364   -
365   - informations.pdf
366   -
367   - The page must provide a link with an authorization. The authorization is just a web
368   - argument, whose name is "zauth". The value of this web argument is computed by hashing
369   - some secret string (known only from the programmer of the web site) with the absolute
370   - path of the file. The HTTPS request will have the form:
371   -
372   - GET /informations.pdf?zauth=d38161f5b4e87e2d46e06ff8b3e233be563794d1
373   -
374   - The server will search for a file named
375   -
376   - zd38161f5b4e87e2d46e06ff8b3e233be563794d1
377   -
378   - (i.e. "z" concatenated with the value of the authorization) in the subdirectory
379   - 'private_download' of the site directory. This file contains the absolute path of the
380   - file, i.e:
381   -
382   - /home/georges/my_documents/my_text.pdf
383   -
384   - At that point, the server may hash the secret string and the absolute path together, to
385   - check if the client is authorized to download the file. If it is the case, it sends the
386   - file (the MIME type is declared as 'application/octet-stream' if it is not recognized).
387   - The file is sent under the visible name.
388   -
389   - The server creates automatically the subdirectory 'private_download/' within the 'site
390   - directory' (for each web site) if it does not already exist. Files in this directory
391   - are deleted when they become too old (for example, after 3 days of life).
392   -
393   - Here is the function for computing the value of the authorization, and for making the
394   - authorization file in 'private_download'.
395   -
396   -public define String
397   - make_authorization
398   - (
399   - String site_directory,
400   - String authorization_secret, // known only by the programmer of the web site
401   - String absolute_path // on server
402   - ).
403   -
404   - See 'web/making_a_web_site.anubis' for the construction of the link for downloading.
405   -
406   -
407   -
408   -
409   -
410   -
411   -
412   -
413   - *** (8) About web argument names.
414   -
415   - The server reserves the name "zauth" for the authorization in the private download
416   - mecanism. Also, if the name of a web arguments begins by "p" (like 'password'), it does
417   - not print the value of the web argument neither on the console or in the journal. A
418   - good politics is to prefix all web arguments by letters distinct from 'p' and 'z'. This
419   - method is used in 'web/making_a_web_site.anubis'. This will avoid clashes of names.
420   -
421   -
422   -
423   -
424   -
425   -
426   - *** (9) A web dispatcher.
427   -
428   - For hosting several sites you may prefer another method which we now describe. We start
429   - a HTTP server on port 80 (or on another port). This server is called the
430   - ``dispatcher''. When a requests arrives, the dispatcher examines the ``host'' HTTP
431   - header, so that it gets the name of the requested host. Then it sends to the client a
432   - page like this one:
433   -
434   - <html>
435   - <head>
436   - <meta http-equiv="Refresh" content="0;URL=...">
437   - </head>
438   - <body>
439   - </body>
440   - </html>
441   -
442   - where the URL represented by '...' is the URL of the requested site. This URL may have
443   - the same IP address as the dispatcher, except that the port number is different. It may
444   - also have a different IP address.
445   -
446   - The dispatcher uses the file 'my_anubis/web_sites/dispatcher.info'. This file contains
447   - a serialized datum of type 'List(DispatcherInfo)'.
448   -
449   -public type DispatcherInfo:
450   - site(String common_name,
451   - Int32 http_port).
452   -
453   - The dispatcher does not write into this file. It reads it when it starts, and rereads
454   - it each time the date of last modification of the file changes, so that the dispatcher
455   - always has up to date data. The file may be managed (written and updated) by another
456   - program.
457   -
458   - So, for each site, the dispatcher knows the common name (needed to recognize the 'host'
459   - HTTP header), and the pair (ip_address,port) used by the actual site for HTTP. The
460   - dispatcher does not worry about HTTPS. HTTPS must be managed by the actual site.
461   -
462   - The dispatcher is started by:
463   -
464   -public define One
465   - start_web_dispatcher
466   - (
467   - Int32 ip_address, // address for listening (typically 0)
468   - Int32 port, // typically 80
469   - DenialOfService dos
470   - ).
471   -
472   - A command line tool for managing the file 'my_anubis/web_sites/dispatcher.info' is also
473   - provided:
474   -
475   -global define One
476   - manage_web_dispatcher
477   - (
478   - List(String) args
479   - ).
480   -
481   -
482   -
483   -
484   -
485   -
486   -
487   - --- That's all for the public part ! --------------------------------------------------
488   -
489   -
490   -
491   -
492   -
493   -
494   -
495   - ----------------------------------- Table of Contents ---------------------------------
496   -
497   - *** [1] Types which are private to this file.
498   -
499   - *** [2] Tools.
500   - *** [2.1] Formating an error message.
501   - *** [2.2] Converting IP addresses.
502   - *** [2.3] Reading and unputting characters.
503   - *** [2.4] Reading and discarding characters.
504   - *** [2.5] Reading a character string.
505   - *** [2.6] Padding integers with zeros.
506   - *** [2.7] Converting web arguments to ASCII.
507   - *** [2.8] Server description.
508   -
509   - *** [3] Managing the journal.
510   - *** [3.1] Naming journal files.
511   - *** [3.2] Formating HTTP headers.
512   - *** [3.3] Formating web arguments.
513   - *** [3.4] Formating the whole request.
514   - *** [3.5] Putting it in the journal file (and on the console).
515   -
516   - *** [4] Reading the HTTP request.
517   - *** [4.1] Skipping leading blanks.
518   - *** [4.2] Reading a new line.
519   - *** [4.3] Reading a 'word'.
520   - *** [4.4] Separating the URI from the query string.
521   - *** [4.5] Reading the web arguments.
522   - *** [4.7] Reading the request line.
523   - *** [4.8] Reading the HTTP headers.
524   - *** [4.9] Getting the size of the request's body.
525   - *** [4.10] Reading the body of the request.
526   -
527   - *** [5] Making the HTTP answer.
528   - *** [5.1] Avoiding illegal URIs.
529   - *** [5.2] Managing authorizations for downloading private files.
530   - *** [5.3] Recognizing MIME types.
531   - *** [5.4] Formating HTTP headers.
532   - *** [5.5] Sending a file.
533   - *** [5.6] Answering a www-url encoded request.
534   - *** [5.7] Answering a multipart/form-data encoded request.
535   - *** [5.7.1] Finding the boundary.
536   - *** [5.7.2] Reading attributes from a multipart entity.
537   - *** [5.7.3] Creating a temporary filename for an uploaded file.
538   - *** [5.7.4] Saving an uploaded file under a temporary filename.
539   - *** [5.7.5] Removing the path from a file name.
540   - *** [5.7.6] Reading a multipart entity.
541   - *** [5.8] Handling redirections.
542   - *** [5.9] Answering both sorts of requests.
543   -
544   - *** [6] The HTTP/HTTPS servers.
545   - *** [6.1] The HTTP request handler.
546   - *** [6.2] Server's tasks.
547   - *** [6.3] Starting the HTTP/HTTPS servers.
548   -
549   - *** [7] The web dispatcher.
550   - *** [7.1] The dispatcher server.
551   - *** [7.2] The dispatcher web site.
552   - *** [7.3] Managing the info file.
553   -
554   - ---------------------------------------------------------------------------------------
555   -
556   -
557   -
558   -
559   -read tools/basis.anubis
560   -read tools/findstring.anubis
561   -read tools/connections.anubis
562   -
563   -
564   -
565   -
566   -
567   - *** [1] Types which are private to this file.
568   -
569   - We use the following self-explanatory types.
570   -
571   -type Error:
572   - cannot_read_from_connection,
573   - not_get_or_post_request(String),
574   - end_of_line_expected,
575   - incorrect_content_length_value,
576   - colon_expected,
577   - timeout(Int32).
578   -
579   -type HTTP_RequestType:
580   - get,
581   - post.
582   -
583   -type HTTP_RequestLine:
584   - request_line (HTTP_RequestType type,
585   - String uri,
586   - List(Web_arg) query_string).
587   -
588   -type EncodingType:
589   - www_url,
590   - multipart_form_data.
591   -
592   -
593   -
594   -
595   -
596   - *** [2] Tools.
597   -
598   - *** [2.1] Formating an error message.
599   -
600   - The next function formats an error message.
601   -
602   -define String
603   - format
604   - (
605   - Error msg
606   - ) =
607   - if msg is
608   - {
609   - cannot_read_from_connection then
610   - "Cannot read from connection.\n",
611   - not_get_or_post_request(s) then
612   - "The request did not begin by 'GET' or 'POST': "+s+".\n",
613   - end_of_line_expected then
614   - "End of line expected.\n",
615   - incorrect_content_length_value then
616   - "Incorrect value for HTTP header 'Content-Length'.\n",
617   - colon_expected then
618   - "':' was expected.\n",
619   - timeout(n) then
620   - //"time out: "+n+"\n"
621   - //"time out.\n"
622   - ""
623   - }.
624   -
625   -
626   -
627   -
628   -
629   -
630   - *** [2.2] Converting IP addresses.
631   -
632   - We need two conversion functions for IP addresses:
633   -
634   - (Word8,Word8,Word8,Word8) --> Int32 ip_address
635   - Int32 --> String ip_addr_to_string
636   -
637   - These conversions are defined in 'tools/basis.anubis'.
638   -
639   -
640   -
641   -
642   -
643   -
644   -
645   -
646   - *** [2.3] Reading and unputting characters.
647   -
648   - We need a mecanism for unputting several characters (actually at least 3). This is
649   - because when reading the client connection, we must sometimes go ahead several
650   - characters, and virtually put them back into the connection, so that they can be
651   - reread. Of course, we do not send them back to the client. We store them in a list
652   - (hold by the variable 'unput_chars'), and we manage this list, so that characters may
653   - be virtually put back in the connection (this is called 'unputting').
654   -
655   -variable List(Word8) unput_chars = [].
656   -
657   - The most recently read one is the head of list. Fortunately, this variable is private
658   - to this virtual machine (hence to this client).
659   -
660   -
661   -define One
662   - unput // unputting a character (add it in front of the list)
663   - (
664   - Word8 character
665   - ) =
666   - unput_chars <- (List(Word8))[character . *unput_chars].
667   -
668   -
669   -
670   -define One record_dubious_IP(Int32 addr,DenialOfService dos).
671   -
672   -variable Int32 sttm = 0. // contains the start time for this connection.
673   -
674   -define Result(Error,Word8)
675   - record_dubious_connection
676   - (
677   - Connection conn,
678   - Int32 dead_line,
679   - DenialOfService dos,
680   - ) =
681   - if remote_IP_address_and_port(conn) is (addr,port) then
682   - record_dubious_IP(addr,dos);
683   - print("Recording IP address "+ip_addr_to_string(addr)+
684   - " as dubious after "+(dead_line-*sttm)+" seconds. Total: "+
685   - length(*list_of_dubious(dos))+"\n");
686   - error(timeout(dead_line)).
687   -
688   -
689   -define Result(Error,Word8)
690   - read_one_byte
691   - (
692   - Connection connection,
693   - Int32 dead_line,
694   - DenialOfService dos
695   - ) =
696   - //if now > dead_line then record_dubious_connection(connection,dead_line,dos) else
697   - if read(connection,1,600) is // the connection is closed after 10 minutes of inactivity
698   - {
699   - error then error(cannot_read_from_connection),
700   - timeout then error(timeout(600)),
701   - //record_dubious_connection(connection,dead_line,dos),
702   - ok(ba) then if nth(0,ba) is
703   - {
704   - failure then error(cannot_read_from_connection),
705   - success(c) then ok(c)
706   - }
707   - }.
708   -
709   -
710   -define Result(Error,Word8)
711   - next_char // reading a character (check the list first, and read on the connection
712   - // only when the list is empty).
713   - (
714   - Connection connection,
715   - Int32 dead_line,
716   - DenialOfService dos
717   - ) =
718   - if *unput_chars is
719   - {
720   - [ ] then read_one_byte(connection,dead_line,dos),
721   -
722   - [h . t] then
723   - unput_chars <- t;
724   - ok(h)
725   - }.
726   -
727   -
728   -
729   -
730   -
731   -
732   -
733   - *** [2.4] Reading and discarding characters.
734   -
735   - The next function reads the specified number of bytes (this is the same as
736   - 'characters') from the connection and discards them. This is used for discarding CR LF
737   - just before the body of a request.
738   -
739   -define Result(Error,One)
740   - read_and_ignore
741   - (
742   - Connection connection, // to client
743   - Int32 dead_line,
744   - Int32 number_of_characters, // number of characters to read and ignore
745   - DenialOfService dos
746   - ) =
747   - if number_of_characters =< 0 then ok(unique) else
748   - if next_char(connection,dead_line,dos) is
749   - {
750   - error(msg) then error(msg),
751   - ok(c) then read_and_ignore(connection,dead_line,number_of_characters-1,dos)
752   - }.
753   -
754   -
755   -
756   -
757   -
758   -
759   -
760   - *** [2.5] Reading a character string.
761   -
762   - Sometimes values of HTTP attributes or web args are presented in the form of double
763   - quoted strings. The next function handles the reading of such things. The leading
764   - double quote is already read in. We must read subsequent characters until the next non
765   - backslashed double quote.
766   -
767   -define Result(Error,String)
768   - read_string
769   - (
770   - Connection connection, // connection with the client
771   - Int32 dead_line,
772   - List(Word8) so_far, // characters read so far (in reverse order)
773   - DenialOfService dos
774   - ) =
775   - if next_char(connection,dead_line,dos) is
776   - {
777   - error(msg) then error(msg),
778   - ok(c) then
779   - if c = '\\'
780   - then if next_char(connection,dead_line,dos) is
781   - {
782   - error(msg) then error(msg),
783   - ok(d) then
784   - if d = '\"'
785   - then read_string(connection,dead_line,['\"' . so_far],dos)
786   - else read_string(connection,dead_line,[d, c . so_far],dos)
787   - }
788   - else if c = '\"'
789   - then ok(implode(reverse(so_far)))
790   - else read_string(connection,dead_line,[c . so_far],dos)
791   - }.
792   -
793   -
794   -
795   -
796   -
797   -
798   -
799   - *** [2.6] Padding integers with zeros.
800   -
801   - 'zero_pad_2' transforms an integer (which is assumed to be between 0 and 99) into a
802   - string with exactly two digits. This is used for formating days, hours, minutes and
803   - seconds.
804   -
805   -define String
806   - zero_pad_2
807   - (
808   - Int32 n
809   - ) =
810   - with s = integer_to_string(n),
811   - if length(s) < 2
812   - then "0"+s
813   - else s.
814   -
815   -
816   -
817   -
818   -
819   -
820   -
821   - *** [2.7] Converting web arguments to ASCII.
822   -
823   - The function 'web_to_ascii' gets a character string and replaces web encoding by normal
824   - ASCII encoding. This amounts to replacing:
825   -
826   - + by blank
827   - %xx by the character whose ASCII code is xx in hexadecimal
828   -
829   - Note: We assume that '9' < 'A' (which is the case for ASCII code).
830   -
831   -
832   -
833   -define Word8
834   - web_decode
835   - (
836   - Word8 x1,
837   - Word8 x2
838   - ) =
839   - with z1 = word8_to_int32(x1),
840   - n1 = if z1 =< '9' then (z1 - '0') else (z1 - 'A' + 10),
841   - z2 = word8_to_int32(x2),
842   - n2 = if z2 =< '9' then (z2 - '0') else (z2 - 'A' + 10),
843   - n = (n1 << 4) + n2,
844   - truncate_to_word8(n).
845   -
846   -
847   -
848   -define String
849   - web_to_ascii
850   - (
851   - String web_string,
852   - Int32 n, // current position in web_string
853   - List(Word8) so_far
854   - ) =
855   - if nth(n,web_string) is
856   - {
857   - failure then implode(reverse(so_far)),
858   - success(c) then
859   - if c = '+'
860   - then web_to_ascii(web_string,n+1,[' ' . so_far])
861   - else if c = '%'
862   - then if nth(n+1,web_string) is
863   - {
864   - failure then implode(reverse(so_far)),
865   - success(x1) then if nth(n+2,web_string) is
866   - {
867   - failure then implode(reverse(so_far)),
868   - success(x2) then web_to_ascii(web_string,n+3,[web_decode(x1,x2) . so_far])
869   - }
870   - }
871   - else web_to_ascii(web_string,n+1,[c . so_far])
872   - }.
873   -
874   -
875   -
876   -
877   -
878   -
879   -
880   -
881   - *** [3] Managing the journal.
882   -
883   - Concurrently working machines should not try to access the same file at the same
884   - time. This problem may be solved by using the 'protect' mecanism.
885   -
886   -
887   -
888   - *** [3.1] Naming journal files.
889   -
890   - Since journal messages are rather prolific, we should have at least one file per
891   - hour. Hence, the name of a journal file must be constructed from the current year,
892   - month, day and hour. For example, it may be:
893   -
894   - 2003_03_12_19
895   -
896   - (this is for the journal of 7 PM to 8 PM, 2003/mar/12).
897   -
898   -define String
899   - make_current_journal_file_name
900   - =
901   - if convert_time(now) is date_and_time(y,m,d,h,_,_,_,_,_) then
902   - integer_to_string(y)+"_"+
903   - zero_pad_2(m)+"_"+
904   - zero_pad_2(d)+"_"+
905   - zero_pad_2(h).
906   -
907   -
908   -
909   -
910   -
911   -
912   -
913   - *** [3.2] Formating HTTP headers.
914   -
915   - HTTP headers may be shown on the console or written in the journal. The function below
916   - formats a list of HTTP headers.
917   -
918   -define String
919   - show_format
920   - (
921   - Web_Site_Description desc,
922   - List(HTTP_header) headers,
923   - ) =
924   - if headers is
925   - {
926   - [ ] then "",
927   - [h . t] then if h is http_header(name,value) then
928   - if member(journal_headers(desc),name)
929   - then " | "+name+": "+value+"\n"+show_format(desc,t)
930   - else show_format(desc,t)
931   - }.
932   -
933   -
934   -
935   -
936   -
937   -
938   - *** [3.3] Formating web arguments.
939   -
940   - The same thing for web arguments.
941   -
942   -define String
943   - show_format
944   - (
945   - List(Web_arg) lwa
946   - ) =
947   - if lwa is
948   - {
949   - [ ] then "",
950   - [h . t] then if h is
951   - {
952   - web_arg(n,v) then
953   - " | "+n+"="+(if nth(0,n) = success('p') then "<not shown>" else v)+"\n"+show_format(t),
954   - upload(n,fn,tfn) then
955   - " | "+n+"="+fn+" (uploaded as '"+tfn+"')\n"+show_format(t)
956   - }
957   - }.
958   -
959   -
960   -
961   -
962   -
963   -
964   - *** [3.4] Formating the whole request.
965   -
966   - It is cheap to transform month numbers into abbreviated month names. This enhances the
967   - readability of the journal.
968   -
969   -define String
970   - format_month
971   - (
972   - Int32 m
973   - ) =
974   - if m = 1 then "jan" else
975   - if m = 2 then "feb" else
976   - if m = 3 then "mar" else
977   - if m = 4 then "apr" else
978   - if m = 5 then "may" else
979   - if m = 6 then "jun" else
980   - if m = 7 then "jul" else
981   - if m = 8 then "aug" else
982   - if m = 9 then "sep" else
983   - if m = 10 then "oct" else
984   - if m = 11 then "nov" else
985   - if m = 12 then "dec" else
986   - "???".
987   -
988   -
989   - Below we format a whole HTTP request. This may give this (actually, it depends on how
990   - you defined the values of 'journal_headers' and 'journal_extensions'):
991   -
992   - [3] 2003/mar/10 10:06:57 from 123.456.123.456: /homepage.awp
993   - | host: www.the-best-one.com
994   - | user-agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0
995   -
996   - The leading number between brackets is the number of the virtual machine which served
997   - the URI.
998   -
999   -define String
1000   - format_request
1001   - (
1002   - Web_Site_Description desc,
1003   - Connection client_connection,
1004   - HTTP_RequestLine request_line,
1005   - List(HTTP_header) headers,
1006   - List(Web_arg) web_args
1007   - ) =
1008   - with dt = convert_time(now),
1009   - if remote_IP_address_and_port(client_connection) is (addr,port) then
1010   - integer_to_string(year(dt))+"/"+format_month(month(dt))+"/"+zero_pad_2(day(dt))+" "+
1011   - zero_pad_2(hour(dt))+":"+zero_pad_2(minute(dt))+":"+zero_pad_2(second(dt))+
1012   - " from "+ip_addr_to_string(addr)+
1013   - ": "+uri(request_line)+"\n"+
1014   - show_format(desc,headers)+
1015   - show_format(web_args).
1016   -
1017   -
1018   -
1019   -
1020   -
1021   -
1022   -
1023   - *** [3.5] Putting it in the journal file (and on the console).
1024   -
1025   - We must not forget to 'protect' this operation, so that the messages of two machines
1026   - (working for the same site) will not be mixed together.
1027   -
1028   -define One
1029   - log_journal_msg
1030   - (
1031   - Web_Site_Description desc,
1032   - String msg,
1033   - ) =
1034   - with msg = to_byte_array("["+virtual_machine_id+"] "+msg+"\n"),
1035   - protect
1036   - (
1037   - if file(site_directory(desc)+"/journal/"+make_current_journal_file_name,append) is
1038   - {
1039   - failure then unique,
1040   - success(journal_file) then
1041   - forget(reliable_write(file(journal_file),msg))
1042   - };
1043   - forget(reliable_write(file(stdout),msg))
1044   - ).
1045   -
1046   -
1047   -
1048   -
1049   -
1050   -
1051   -
1052   - *** [4] Reading the HTTP request.
1053   -
1054   -
1055   - *** [4.1] Skipping leading blanks.
1056   -
1057   - One of the peculiarities of HTTP is that the characters 13 (carriage return) and 10
1058   - (line feed) followed by either a space (32) or a tab (9), is considered as a blank not
1059   - containing any new line. 'skip_http_blanks' must skip all blanks characters until the
1060   - first non blank character, which should not be read in. Obviously, because of the above
1061   - peculiarity, we need at least 3 characters of lookahead to do this. In other words, we
1062   - must be able to unput at least 3 characters (hopefully we are).
1063   -
1064   - Strictly blanks characters are 'space' and 'tab'.
1065   -
1066   -define Bool
1067   - is_strict_blank
1068   - (
1069   - Word8 c
1070   - ) =
1071   - if c = ' ' then true else c = '\t'.
1072   -
1073   -
1074   - On the contrary, blanks include 13 and 10.
1075   -
1076   -define Bool
1077   - is_blank
1078   - (
1079   - Word8 c
1080   - ) =
1081   - if c = ' ' then true else
1082   - if c = '\t' then true else
1083   - if c = 13 then true else
1084   - c = 10.
1085   -
1086   -
1087   - Skipping HTTP blanks.
1088   -
1089   -define Result(Error,One)
1090   - skip_http_blanks
1091   - (
1092   - Connection connection,
1093   - Int32 dead_line,
1094   - DenialOfService dos
1095   - ) =
1096   - if next_char(connection,dead_line,dos) is
1097   - {
1098   - error(msg) then error(msg),
1099   - ok(c) then
1100   - if is_strict_blank(c)
1101   - then skip_http_blanks(connection,dead_line,dos)
1102   - else if c = 13
1103   - then if next_char(connection,dead_line,dos) is
1104   - {
1105   - error(msg) then error(msg), // (unput(c); ok(unique)),
1106   - ok(d) then
1107   - if d = 10
1108   - then if next_char(connection,dead_line,dos) is
1109   - {
1110   - error(msg) then error(msg), // (unput(d); unput(c); ok(unique)),
1111   - ok(e) then
1112   - if is_strict_blank(e)
1113   - then skip_http_blanks(connection,dead_line,dos)
1114   - else (unput(e); unput(d); unput(c); ok(unique))
1115   - }
1116   - else (unput(d); unput(c); ok(unique))
1117   - }
1118   - else (unput(c); ok(unique))
1119   - }.
1120   -
1121   -
1122   -
1123   -
1124   -
1125   -
1126   -
1127   -
1128   - *** [4.2] Reading a new line.
1129   -
1130   - Normally in HTTP a new line is the sequence 13 10 (carriage return line feed), not
1131   - followed by a space or tabulator. If it is followed by a space or tabulator, the three
1132   - characters are considered blanks, and no new line has been read. Before trying to read
1133   - a new line, we first skip leading spaces and tabs. Then we try to read 13 and 10, and
1134   - we read another character. if this character is space or tab, we consider we have read
1135   - only blanks and we continue reading in order to find our new line. Otherwise, we unput
1136   - this character (which may be for example the first character of the name of the next
1137   - header), and answer that we have seen a new line.
1138   -
1139   - Warning: we must not use this function for reading the last pair (13,10) before the
1140   - beginning of the body, because if the body is empty, there is no character to read
1141   - after this pair, so that the server could wait for a character which will never
1142   - come. This is the reason for 'read_and_ignore' above, which is used precisely for
1143   - reading that last (13,10) pair.
1144   -
1145   -define Result(Error,One)
1146   - read_new_line
1147   - (
1148   - Connection connection,
1149   - Int32 dead_line,
1150   - DenialOfService dos
1151   - ) =
1152   - if skip_http_blanks(connection,dead_line,dos) is
1153   - {
1154   - error(msg) then error(msg),
1155   - ok(_) then
1156   - if next_char(connection,dead_line,dos) is
1157   - {
1158   - error(msg) then error(msg),
1159   - ok(c) then
1160   - if c = 13
1161   - then if next_char(connection,dead_line,dos) is
1162   - {
1163   - error(msg) then error(msg),
1164   - ok(d) then
1165   - if d = 10
1166   - then ok(unique)
1167   - else (unput(d);
1168   - unput(c);
1169   - error(end_of_line_expected))
1170   - }
1171   - else (unput(c);
1172   - error(end_of_line_expected))
1173   - }}.
1174   -
1175   -
1176   -
1177   -
1178   -
1179   -
1180   -
1181   -
1182   - *** [4.3] Reading a 'word'.
1183   -
1184   - A 'word' is a sequence of characters which begins either by a double quote or not by a
1185   - double quote. (However, any leading blanks are read in and ignored. This is
1186   - accomplished by 'skip_http_blanks'.) If it begins by a double quote, it is read like a
1187   - string, i.e. it ends at the next (non backslashed) double quote. Otherwise, it is
1188   - right delimited by any character which may be considered as 'blank'. If the word is
1189   - double quoted, the closing double quote is read in. On the contrary, if the word is not
1190   - double quoted, the right delimiting blank character is not read in (it is 'unput' back
1191   - into the connection), and may be read in again. This is needed because carriage return
1192   - or line feed which are 'blank', also have a meaning in HTTP.
1193   -
1194   -define Result(Error,String)
1195   - read_word_aux
1196   - (
1197   - Connection connection,
1198   - Int32 dead_line,
1199   - List(Word8) so_far,
1200   - DenialOfService dos
1201   - ) =
1202   - if next_char(connection,dead_line,dos) is
1203   - {
1204   - error(msg) then error(msg),
1205   - ok(c) then
1206   - if is_blank(c)
1207   - then (unput(c);
1208   - ok(implode(reverse(so_far))))
1209   - else read_word_aux(connection,dead_line,[c . so_far],dos)
1210   - }.
1211   -
1212   -define Result(Error,String)
1213   - read_word
1214   - (
1215   - Connection connection,
1216   - Int32 dead_line,
1217   - DenialOfService dos
1218   - ) =
1219   - if skip_http_blanks(connection,dead_line,dos) is
1220   - {
1221   - error(msg) then error(msg),
1222   - ok(_) then
1223   - if next_char(connection,dead_line,dos) is
1224   - {
1225   - error(msg) then error(msg),
1226   - ok(c) then
1227   - if c = '\"'
1228   - then read_string(connection,dead_line,[],dos)
1229   - else read_word_aux(connection,dead_line,[c],dos)
1230   - }
1231   - }.
1232   -
1233   -
1234   -
1235   -
1236   -
1237   -
1238   -
1239   -
1240   - *** [4.4] Separating the URI from the query string.
1241   -
1242   - A 'query string' may be postfixed to the URI, just after a question mark. For example,
1243   - the client may send the following request:
1244   -
1245   - GET /catalog.awp?item=3&color=blue
1246   -
1247   - We separate this into an URI: "/catalog.awp" and the string: "item=3&color=blue" which
1248   - will be later transformed into the list:
1249   -
1250   - [web_arg("item","3"),web_arg("color","blue")]
1251   -
1252   -
1253   -define (String,String)
1254   - separate_uri_from_query_string
1255   - (
1256   - String uri_and_query_string,
1257   - Int32 n
1258   - ) =
1259   - if nth(n,uri_and_query_string) is
1260   - {
1261   - failure then (uri_and_query_string,""),
1262   - success(c) then
1263   - if c = '?'
1264   - then (substr(uri_and_query_string,0,n),
1265   - substr(uri_and_query_string,n+1,length(uri_and_query_string)-(n+1)))
1266   - else separate_uri_from_query_string(uri_and_query_string,n+1)
1267   - }.
1268   -
1269   -
1270   -
1271   -
1272   -
1273   -
1274   -
1275   -
1276   -
1277   - *** [4.5] Reading the web arguments.
1278   -
1279   - HTTP/HTTPS requests are sent in one of two formats:
1280   -
1281   - (1) www-url encoded
1282   - (2) multipart/form-data encoded
1283   -
1284   - The first one is the normal (historical) way of encoding. The second one is required
1285   - for uploading files. A server which is supposed to accept upload of files must handle
1286   - both formats. The first thing to do is to decide the format of the request. This is
1287   - easily done by examining the HTTP headers. If we find the header:
1288   -
1289   - Content-Type: multipart/form-data
1290   -
1291   - the request is multipart/form-data encoded. Otherwise, it is 'www-url' encoded. We
1292   - first consider 'www-url' encoded requests.
1293   -
1294   - For a 'www-url' encoded request, the web argument are either in the query string or in
1295   - the body of the request, or both. The format is the same for both:
1296   -
1297   - name=value&name=value&...
1298   -
1299   - However, we may also have
1300   -
1301   - name
1302   - name=
1303   - name=&...
1304   - name&...
1305   -
1306   - i.e. some parts may be missing. Hence, we must be careful.
1307   -
1308   - Furthermore, web arguments must be translated from web to ASCII when www-url encoded.
1309   -
1310   -define Bool
1311   - is_ampersand_or_equal
1312   - (
1313   - Word8 c
1314   - ) =
1315   - if c = '&' then true else c = '='.
1316   -
1317   -
1318   -
1319   - The function 'read_name_or_value' reads the string 's' starting at position 'n' until
1320   - either the end of the string or the first '&' or '='.
1321   -
1322   -define String
1323   - read_name_or_value
1324   - (
1325   - String s,
1326   - Int32 start,
1327   - Int32 i
1328   - ) =
1329   - if nth(i,s) is
1330   - {
1331   - failure then substr(s,start,i - start),
1332   - success(c) then
1333   - if is_ampersand_or_equal(c)
1334   - then substr(s,start,i-start) // the separator is not included
1335   - else read_name_or_value(s,start,i+1)
1336   - }.
1337   -
1338   -
1339   -define List(Web_arg)
1340   - read_www_url_encoded_web_args
1341   - (
1342   - String s,
1343   - Int32 start,
1344   - ) =
1345   - with first = read_name_or_value(s,start,start),
1346   - if first = ""
1347   - then []
1348   - else with i = start+length(first),
1349   - if nth(i,s) is
1350   - {
1351   - failure then [web_arg(first,"")],
1352   - success(c) then
1353   - if c = '&'
1354   - then [web_arg(first,"") . read_www_url_encoded_web_args(s,i+1)]
1355   - else if c = '='
1356   - then with second1 = read_name_or_value(s,i+1,i+1),
1357   - // print("\""+second1+"\"\n");
1358   - with second = web_to_ascii(second1,0,[]),
1359   - [web_arg(first,second) . read_www_url_encoded_web_args(s,i+length(second1)+2)]
1360   - else alert
1361   - }.
1362   -
1363   -
1364   -
1365   -
1366   -
1367   - *** [4.7] Reading the request line.
1368   -
1369   - 'read_request_line' reads three words and a new line from the connection. It tries to
1370   - recognize "GET" or "POST" in the first word, separates the URI from the query string in
1371   - the second word, transforms the query string into a list of 'Web_arg', and finally
1372   - returns a datum of type 'HTTP_RequestLine' if no error arose.
1373   -
1374   -
1375   -define Result(Error,HTTP_RequestType)
1376   - identify_get_or_post
1377   - (
1378   - String s
1379   - ) =
1380   - with s = to_lower(s),
1381   - if s = "get" then ok(get) else
1382   - if s = "post" then ok(post) else
1383   - error(not_get_or_post_request(s)).
1384   -
1385   -define Result(Error,HTTP_RequestLine)
1386   - read_request_line
1387   - (
1388   - Connection connection,
1389   - Int32 dead_line,
1390   - DenialOfService dos
1391   - ) =
1392   - if read_word(connection,dead_line,dos) is
1393   - {
1394   - error(msg) then error(msg),
1395   - ok(get_or_post) then if read_word(connection,dead_line,dos) is
1396   - {
1397   - error(msg) then error(msg),
1398   - ok(uri_and_query_string) then if read_word(connection,dead_line,dos) is
1399   - {
1400   - error(msg) then error(msg),
1401   - ok(http_version) then if read_new_line(connection,dead_line,dos) is
1402   - {
1403   - error(msg) then error(msg),
1404   - ok(_) then if separate_uri_from_query_string(uri_and_query_string,0) is
1405   - (uri,query_string) then if identify_get_or_post(get_or_post) is
1406   - {
1407   - error(msg) then error(msg),
1408   - ok(request_type) then
1409   - ok(request_line(request_type,uri,read_www_url_encoded_web_args(query_string,0)))
1410   - }
1411   - }
1412   - }
1413   - }
1414   - }.
1415   -
1416   -
1417   -
1418   -
1419   -
1420   -
1421   -
1422   - *** [4.8] Reading the HTTP headers.
1423   -
1424   - Each header is made of a name (containing only letters, the underscore, digits and the
1425   - minus sign), a colon, a value, and a new line. The first empty line ends the headers.
1426   -
1427   -
1428   - The next function tests characters acceptable in a header name.
1429   -
1430   -define Bool
1431   - is_header_name_char
1432   - (
1433   - Word8 c
1434   - ) =
1435   - with n = word8_to_int32(c),
1436   - if ('a' =< n & n =< 'z') then true else
1437   - if ('A' =< n & n =< 'Z') then true else
1438   - if ('0' =< n & n =< '9') then true else
1439   - if c = '-' then true else
1440   - c = '_'.
1441   -
1442   -define Result(Error,String)
1443   - read_header_name
1444   - (
1445   - Connection connection,
1446   - Int32 dead_line,
1447   - List(Word8) so_far,
1448   - DenialOfService dos
1449   - ) =
1450   - if next_char(connection,dead_line,dos) is
1451   - {
1452   - error(msg) then error(msg),
1453   - ok(c) then
1454   - if is_header_name_char(c)
1455   - then read_header_name(connection,dead_line,[to_lower(c) . so_far],dos)
1456   - else unput(c); ok(implode(reverse(so_far)))
1457   - }.
1458   -
1459   -define Result(Error,One)
1460   - skip_colon
1461   - (
1462   - Connection connection,
1463   - Int32 dead_line,
1464   - DenialOfService dos
1465   - ) =
1466   - if skip_http_blanks(connection,dead_line,dos) is
1467   - {
1468   - error(msg) then error(msg),
1469   - ok(_) then
1470   - if next_char(connection,dead_line,dos) is
1471   - {
1472   - error(msg) then error(msg),
1473   - ok(c) then
1474   - if c = ':'
1475   - then ok(unique)
1476   - else error(colon_expected)
1477   - }}.
1478   -
1479   -
1480   -define Result(Error,String)
1481   - read_header_value
1482   - (
1483   - Connection connection,
1484   - Int32 dead_line,
1485   - List(Word8) so_far,
1486   - DenialOfService dos
1487   - ) =
1488   - if next_char(connection,dead_line,dos) is
1489   - {
1490   - error(msg) then error(msg),
1491   - ok(c) then
1492   - if c = 13
1493   - then if next_char(connection,dead_line,dos) is
1494   - {
1495   - error(msg) then error(msg),
1496   - ok(d) then
1497   - if d = 10
1498   - then if next_char(connection,dead_line,dos) is
1499   - {
1500   - error(msg) then error(msg),
1501   - ok(e) then
1502   - if is_strict_blank(e)
1503   - then read_header_value(connection,dead_line,[e . so_far],dos)
1504   - else (unput(e); ok(implode(reverse(so_far))))
1505   - }
1506   - else read_header_value(connection,dead_line,[d, c . so_far],dos)
1507   - }
1508   - else read_header_value(connection,dead_line,[c . so_far],dos)
1509   - }.
1510   -
1511   -
1512   - Reading a single header.
1513   -
1514   -define Result(Error,Maybe(HTTP_header))
1515   - read_header
1516   - (
1517   - Connection connection,
1518   - Int32 dead_line,
1519   - DenialOfService dos
1520   - ) =
1521   - if read_header_name(connection,dead_line,[],dos) is
1522   - {
1523   - error(msg) then error(msg),
1524   - ok(name) then
1525   - if name = "" then
1526   - if read_and_ignore(connection,dead_line,2,dos) /* 13 and 10 */ is
1527   - {
1528   - error(msg) then error(msg),
1529   - ok(_) then // this is the blank line
1530   - ok(failure) // end of headers
1531   - }
1532   - else if skip_colon(connection,dead_line,dos) is
1533   - {
1534   - error(msg) then error(msg),
1535   - ok(_) then if skip_http_blanks(connection,dead_line,dos) is
1536   - {
1537   - error(msg) then error(msg),
1538   - ok(_) then if read_header_value(connection,dead_line,[],dos) is
1539   - {
1540   - error(msg) then error(msg),
1541   - ok(value) then
1542   - ok(success(http_header(name,value)))
1543   - }
1544   - }
1545   - }
1546   - }.
1547   -
1548   -
1549   -
1550   - Reading all the headers.
1551   -
1552   -define Result(Error,List(HTTP_header))
1553   - read_http_headers
1554   - (
1555   - Connection connection,
1556   - Int32 dead_line,
1557   - DenialOfService dos
1558   - ) =
1559   - if read_header(connection,dead_line,dos) is
1560   - {
1561   - error(msg) then error(msg),
1562   - ok(mbh) then if mbh is
1563   - {
1564   - failure then ok([ ]),
1565   - success(header) then
1566   - if read_http_headers(connection,dead_line,dos) is
1567   - {
1568   - error(msg) then error(msg),
1569   - ok(others) then ok([header . others])
1570   - }
1571   - }
1572   - }.
1573   -
1574   -
1575   -
1576   -
1577   -
1578   -
1579   -
1580   - *** [4.9] Getting the size of the request's body.
1581   -
1582   - The size of the body of the request is given under the 'Content-Length' header. If this
1583   - header is not present, the size is assumed to be zero.
1584   -
1585   -define Result(Error,Int32)
1586   - get_body_size
1587   - (
1588   - List(HTTP_header) headers
1589   - ) =
1590   - if headers is
1591   - {
1592   - [ ] then ok(0),
1593   - [h . t] then if h is http_header(name,value) then
1594   - if name = "content-length"
1595   - then if string_to_integer(value) is
1596   - {
1597   - failure then error(incorrect_content_length_value),
1598   - success(n) then ok(n)
1599   - }
1600   - else get_body_size(t)
1601   - }.
1602   -
1603   -
1604   -
1605   -
1606   -
1607   -
1608   -
1609   -
1610   -
1611   -
1612   - *** [4.10] Reading the body of the request.
1613   -
1614   - The body of the request may be very big (it contains uploaded files, if any). We read
1615   - it using the primitive 'read', which returns the number of bytes read, which may be
1616   - less than the number of bytes we wanted to read. This is not an error, but simply due
1617   - to the fact the buffer associated with the connection in the Linux (or MS-Windows)
1618   - kernel has a limited size. Hence, we must read bytes again until we have read the
1619   - required number of bytes. However, if the number of bytes read is zero, the connection
1620   - may be broken. In that case, we must not try to read indefinitely. On the contrary, we
1621   - make at most 10 retries, with a small sleeping time between any two of them.
1622   -
1623   -define Result(Error,ByteArray)
1624   - read_http_body
1625   - (
1626   - Connection connection,
1627   - Int32 body_size,
1628   - ByteArray so_far, // when calling this function, 'so_far' is the empty byte array
1629   - Int32 retries // this function is called with retries = 10
1630   - ) =
1631   - if body_size = 0 then ok(constant_byte_array(0,0)) else
1632   - if retries =< 0 then error(cannot_read_from_connection) else
1633   - if read(connection,body_size,60) is
1634   - {
1635   - error then error(cannot_read_from_connection),
1636   - timeout then error(timeout(60)),
1637   - ok(new_bytes) then with
1638   - ba = so_far + new_bytes, // contains all the bytes read so far
1639   - nr = length(ba), // total read since the beginning
1640   - nn = length(new_bytes), // number of bytes just read
1641   - if nr < body_size // must read more bytes
1642   - then if nn > 0 // if connection seems to work
1643   - then read_http_body(connection,body_size,ba,1000) // continue reading
1644   - else sleep(100); // otherwise, sleep 1/10 of second
1645   - read_http_body(connection,body_size,ba, // and retry reading
1646   - retries-1) // but no more than 10 times
1647   - else ok(ba) // required number of bytes has been read
1648   - }.
1649   -
1650   -
1651   - Note: During sleeping, 'anbexec' runs other machines. Actually, calling 'sleep', even
1652   - for one millisecond, is some way of giving up explicitly, so that other virtual
1653   - machines may work.
1654   -
1655   -
1656   -
1657   -
1658   -
1659   -
1660   -
1661   -
1662   -
1663   -
1664   -
1665   -
1666   - *** [5] Making the HTTP answer.
1667   -
1668   - At that point we have read the request line, the headers and the body of the
1669   - request, and we must decide what to do.
1670   -
1671   - Actually, we can do one of the following:
1672   -
1673   - - send a file,
1674   - - execute 'tickets_and_web_page' in case of an ".awp" URI.
1675   -
1676   - The uploaded file (which are in the body of the request) are saved into temporary files
1677   - below.
1678   -
1679   -
1680   -
1681   -
1682   -
1683   - *** [5.1] Avoiding illegal URIs.
1684   -
1685   - For security reasons, we must avoid illegal URIs, for example those which may climb up
1686   - in the file hierarchy. First we accept only few characters in URIs.
1687   -
1688   -define Bool
1689   - is_legal_uri_char
1690   - (
1691   - Word8 c
1692   - ) =
1693   - with n = word8_to_int32(c),
1694   - if ('a' =< n & n =< 'z') then true else // accept 'a' to 'z'
1695   - if ('A' =< n & n =< 'Z') then true else // accept 'A' to 'Z'
1696   - if ('0' =< n & n =< '9') then true else // accept '0' to '9'
1697   - if c = '.' then true else // accept '.' '-' '/' and '_'
1698   - if c = '-' then true else
1699   - if c = '/' then true else
1700   - c = '_'.
1701   -
1702   - We do not accept ~ which is some way of climbing. Of course, we cannot disallow single
1703   - dots, which are most often present in legal URIs, but we must avoid double dots ..
1704   - which mean 'climb up'.
1705   -
1706   -define Bool
1707   - is_illegal_uri
1708   - (
1709   - String uri,
1710   - Int32 n
1711   - ) =
1712   - if nth(n,uri) is
1713   - {
1714   - failure then false,
1715   - success(c) then
1716   - if c = '.' // first dot
1717   - then if nth(n+1,uri) is
1718   - {
1719   - failure then false,
1720   - success(d) then
1721   - if d = '.' // second dot
1722   - then true
1723   - else is_illegal_uri(uri,n+1)
1724   - }
1725   - else is_illegal_uri(uri,n+1)
1726   - }.
1727   -
1728   -
1729   -
1730   -
1731   -
1732   -
1733   - *** [5.2] Managing authorizations for downloading private files.
1734   -
1735   - Computing the authorization and making the authorization file (containing the absolute
1736   - path of the file on the server).
1737   -
1738   -
1739   -define String
1740   - compute_authorization
1741   - (
1742   - String authorization_secret,
1743   - String absolute_path
1744   - ) =
1745   - to_ascii(sha1((authorization_secret,
1746   - absolute_path))).
1747   -
1748   -
1749   -public define String
1750   - make_authorization
1751   - (
1752   - String site_directory,
1753   - String authorization_secret,
1754   - String absolute_path
1755   - ) =
1756   - with private_download_dir = site_directory+"/private_download",
1757   - auth = compute_authorization(authorization_secret,
1758   - absolute_path),
1759   - forget(save(absolute_path,
1760   - private_download_dir+"/z"+auth));
1761   - auth.
1762   -
1763   -
1764   - The function 'send_file' defined below handles the recognition of authorizations.
1765   -
1766   -
1767   -
1768   -
1769   -
1770   - *** [5.3] Recognizing MIME types.
1771   -
1772   - The extension of the (redirected) URI must be either ".awp" or recognized as associated
1773   - to a MIME type. Otherwise, the server will not send the file. This is for security, but
1774   - also because, we must generate a 'Content-Type' header in the answer, with the right
1775   - MIME type.
1776   -
1777   -define String
1778   - get_uri_extension_aux
1779   - (
1780   - String uri,
1781   - Int32 n // used for searching backwards
1782   - ) =
1783   - if nth(n,uri) is
1784   - {
1785   - failure then "",
1786   - success(c) then
1787   - if c = '.' then substr(uri,n,length(uri)-n)
1788   - else if c = '/' then ""
1789   - else get_uri_extension_aux(uri,n-1)
1790   - }.
1791   -
1792   -public define String
1793   - get_uri_extension
1794   - (
1795   - String uri
1796   - ) =
1797   - get_uri_extension_aux(uri,
1798   - length(uri)-1). // search starts at the right end
1799   -
1800   -
1801   -
1802   -define Maybe(String)
1803   - recognize_mime_type_from_ext
1804   - (
1805   - String ext,
1806   - List(MIME) l
1807   - ) =
1808   - if l is
1809   - {
1810   - [ ] then success("application/octet-stream"), // failure,
1811   - [h . t] then if h is mime(mime_type,extension) then
1812   - if ext = extension
1813   - then success(mime_type)
1814   - else recognize_mime_type_from_ext(ext,t)
1815   - }.
1816   -
1817   -define Maybe(String)
1818   - recognize_mime_type_from_uri
1819   - (
1820   - Web_Site_Description desc,
1821   - String uri
1822   - ) =
1823   - recognize_mime_type_from_ext(get_uri_extension(uri),known_mime_types(desc)).
1824   -
1825   -
1826   -
1827   -
1828   -
1829   -
1830   -
1831   -
1832   - *** [5.4] Formating HTTP headers.
1833   -
1834   - This is the formating for sending to the client (hence, it has nothing to do with the
1835   - component 'journal_headers' in the web site description).
1836   -
1837   -define Printable_tree
1838   - format_headers
1839   - (
1840   - List(HTTP_header) headers
1841   - ) =
1842   - if headers is
1843   - {
1844   - [ ] then [ ],
1845   - [h . t] then if h is http_header(name,value) then
1846   - [name,": ",value,crlf . format_headers(t)]
1847   - }.
1848   -
1849   -
1850   -
1851   -
1852   -
1853   -
1854   - *** [5.5] Sending a file.
1855   -
1856   - We send 2 headers 'Content-Type' and 'Content-Length'.
1857   -
1858   -define List(HTTP_header)
1859   - headers_for_send_file
1860   - (
1861   - String mime_type,
1862   - Int32 size,
1863   - ) =
1864   - [
1865   - http_header("Content-Type",mime_type),
1866   - http_header("Content-Length",integer_to_string(size)),
1867   - ].
1868   -
1869   -
1870   -
1871   - Sending the body of the answer (i.e. the file itself).
1872   -
1873   -define One
1874   - send_file_body
1875   - (
1876   - Web_Site_Description desc,
1877   - Connection connection, // connection with the client
1878   - Connection file, // file to be sent already opened
1879   - Int32 size, // size of file
1880   - Int32 sent, // bytes already sent
1881   - String filename // name of file
1882   - ) =
1883   - if sent >= size then unique else
1884   - if read(file,min(10000,size-sent),60) is
1885   - {
1886   - error then log_journal_msg(desc,"Cannot read from file '"+filename+"'.\n"),
1887   - timeout then log_journal_msg(desc,"Cannot read from file timeoput'"+filename+"'.\n"),
1888   - ok(ba) then
1889   - with nr = length(ba), // get the number of bytes read
1890   - if reliable_write(connection,ba) is
1891   - {
1892   - failure then log_journal_msg(desc,"Cannot write into connection.\n"),
1893   - success(nw) then
1894   - send_file_body(desc,connection,file,size,sent+nw,filename)
1895   - }
1896   - }.
1897   -
1898   -
1899   -
1900   -
1901   - Sending the answer line, the headers and the body.
1902   -
1903   -define One
1904   - send_file
1905   - (
1906   - Web_Site_Description desc,
1907   - Connection connection,
1908   - List(HTTP_header) headers,
1909   - Int32 size,
1910   - Connection file,
1911   - String filename,
1912   - One -> One action_before_send_file
1913   - ) =
1914   - action_before_send_file(unique);
1915   - forget(reliable_write(connection,to_byte_array("HTTP/1.1 200 OK"+crlf)));
1916   - forget(reliable_write(connection,[format_headers(headers) , crlf]));
1917   - send_file_body(desc,connection,file,size,0,filename).
1918   -
1919   -
1920   -
1921   - Checking if a connection is under SSL.
1922   -
1923   -define Bool
1924   - is_SSL
1925   - (
1926   - Connection c
1927   - ) =
1928   - if c is
1929   - {
1930   - file_r(_) then false,
1931   - file_w(_) then false,
1932   - file_rw(_) then false,
1933   - tcp(_) then false,
1934   - ssl(_) then true
1935   - }.
1936   -
1937   -
1938   -
1939   - Before opening and sending a file, we check the MIME type. It must be recognized,
1940   - except if there is a valid authorization for private download.
1941   -
1942   -define One
1943   - send_file
1944   - (
1945   - Web_Site_Description desc,
1946   - Connection connection,
1947   - String uri,
1948   - Maybe(String) mbauthorization,
1949   - One -> One action_before_send_file
1950   - ) =
1951   - if mbauthorization is
1952   - {
1953   - //--- file without authorization: take it from public ---
1954   - failure then if recognize_mime_type_from_uri(desc,uri) is
1955   - {
1956   - failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"),
1957   - success(mime_type) then
1958   - with path = site_directory(desc)+"/public"+uri,
1959   - if (Maybe(RStream))connect to file path is
1960   - {
1961   - failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"),
1962   - success(f) then with size = file_size(f),
1963   - send_file(desc,
1964   - connection,
1965   - headers_for_send_file(mime_type,size),
1966   - size,
1967   - file(f),
1968   - uri,
1969   - action_before_send_file)
1970   - }
1971   - },
1972   -
1973   - //--- file with authorization: apply 'private download' mecanism ---
1974   - success(authorization) then
1975   - with private_download_dir = site_directory(desc)+"/private_download",
1976   - if (RetrieveResult(String))retrieve(private_download_dir+"/z"+authorization)
1977   - is ok(absolute_path)
1978   - then (
1979   - with new_hash = compute_authorization(authorization_secret(desc),
1980   - absolute_path),
1981   - if (Maybe(RStream))connect to file absolute_path is
1982   - {
1983   - failure then log_journal_msg(desc,"Cannot find file '"+absolute_path+"'.\n"),
1984   - success(f) then with size = file_size(f),
1985   - send_file(desc,
1986   - connection,
1987   - headers_for_send_file(if recognize_mime_type_from_uri(desc,uri) is
1988   - {
1989   - failure then "application/octet-stream"
1990   - success(mime_type) then mime_type
1991   - },
1992   - size),
1993   - size,
1994   - file(f),
1995   - uri,
1996   - action_before_send_file)
1997   - }
1998   - )
1999   - else log_journal_msg(desc,"Cannot find or read authorization file.\n")
2000   - }.
2001   -
2002   -
2003   - define One
2004   - send_file
2005   - (
2006   - Web_Site_Description desc,
2007   - Connection connection,
2008   - String uri,
2009   - Maybe(String) mbauthorization,
2010   - One -> One action_before_send_file
2011   - ) =
2012   - if mbauthorization is
2013   - {
2014   - //--- file without authorization: take it from public ---
2015   - failure then if recognize_mime_type_from_uri(desc,uri) is
2016   - {
2017   - failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"),
2018   - success(mime_type) then
2019   - with path = site_directory(desc)+"/public"+uri,
2020   - if (Maybe(RStream))connect to file path is
2021   - {
2022   - failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"),
2023   - success(f) then with size = file_size(f),
2024   - send_file(desc,
2025   - connection,
2026   - headers_for_send_file(mime_type,size),
2027   - size,
2028   - file(f),
2029   - uri,
2030   - action_before_send_file)
2031   - }
2032   - },
2033   -
2034   - //--- file with authorization: apply 'private download' mecanism ---
2035   - success(authorization) then
2036   - if is_SSL(connection)
2037   - then (
2038   - with private_download_dir = site_directory(desc)+"/private_download",
2039   - if (RetrieveResult(String))retrieve(private_download_dir+"/z"+authorization)
2040   - is ok(absolute_path)
2041   - then (
2042   - with new_hash = compute_authorization(authorization_secret(desc),
2043   - absolute_path),
2044   - if (Maybe(RStream))connect to file absolute_path is
2045   - {
2046   - failure then log_journal_msg(desc,"Cannot find file '"+absolute_path+"'.\n"),
2047   - success(f) then with size = file_size(f),
2048   - send_file(desc,
2049   - connection,
2050   - headers_for_send_file(if recognize_mime_type_from_uri(desc,uri) is
2051   - {
2052   - failure then "application/octet-stream"
2053   - success(mime_type) then mime_type
2054   - },
2055   - size),
2056   - size,
2057   - file(f),
2058   - uri,
2059   - action_before_send_file)
2060   - }
2061   - )
2062   - else log_journal_msg(desc,"Cannot find or read authorization file.\n")
2063   - )
2064   - else //-- file with authorization, but under HTTP: take it from private_download
2065   - if recognize_mime_type_from_uri(desc,uri) is
2066   - {
2067   - failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"),
2068   - success(mime_type) then
2069   - with path = site_directory(desc)+"/private_download"+uri,
2070   - if (Maybe(RStream))connect to file path is
2071   - {
2072   - failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"),
2073   - success(f) then with size = file_size(f),
2074   - send_file(desc,
2075   - connection,
2076   - headers_for_send_file(mime_type,size),
2077   - size,
2078   - file(f),
2079   - uri,
2080   - action_before_send_file)
2081   - }
2082   - }
2083   - }.
2084   -
2085   -
2086   -
2087   -
2088   -
2089   -
2090   -
2091   - *** [5.6] Answering a www-url encoded request.
2092   -
2093   - Standard headers are for answering ".awp" requests.
2094   -
2095   -define List(HTTP_header)
2096   - standard_headers
2097   - (
2098   - Int32 answer_body_size,
2099   - String charset
2100   - ) =
2101   - [
2102   - //http_header("Content-Type","text/html"),
2103   - http_header("Content-Type","text/html; charset="+charset),
2104   - http_header("Content-length",integer_to_string(answer_body_size))
2105   - ].
2106   -
2107   -
2108   -define One
2109   - www_url_answer
2110   - (
2111   - String host_name,
2112   - Web_Site_Description desc,
2113   - Connection connection, // with the client
2114   - Int32 ip_addr, // of the client
2115   - HTTP_RequestLine request_line,
2116   - List(HTTP_header) headers,
2117   - ByteArray body,
2118   - One -> String generate_tt // trust ticket generation
2119   - ) =
2120   - with all_web_args = query_string(request_line) +
2121   - read_www_url_encoded_web_args(to_string(body),0),
2122   - uri = uri(request_line),
2123   - ext = get_uri_extension(uri),
2124   - (if member(journal_extensions(desc),ext)
2125   - then log_journal_msg(desc,
2126   - format_request(desc,connection,request_line,headers,all_web_args))
2127   - else unique);
2128   - if is_illegal_uri(uri,0)
2129   - then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
2130   - else (if (ext = ".awp" | ext = "")
2131   - then (with answer_headers_body = awp_handler(desc)(host_name,
2132   - http_info(ip_addr,uri,headers,generate_tt),
2133   - all_web_args,
2134   - is_SSL(connection)),
2135   - if answer_headers_body is (additional_headers,answer_body) then
2136   - forget(reliable_write(connection,
2137   - [ "HTTP/1.1 200 OK", crlf,
2138   - format_headers(standard_headers(length(answer_body),charset(desc))),
2139   - format_headers(additional_headers),
2140   - crlf .
2141   - answer_body])))
2142   - else (send_file(desc,
2143   - connection,
2144   - uri,
2145   - if web_arg_value(all_web_args,"zauth") is
2146   - {
2147   - not_found then failure,
2148   - found(v) then success(v)
2149   - },
2150   - (One u) |-> before_send_file(desc)(all_web_args)))).
2151   -
2152   -
2153   -
2154   -
2155   -
2156   -
2157   -
2158   - *** [5.7] Answering a multipart/form-data encoded request.
2159   -
2160   - In order to support upload of files, we must be able to read web arguments which are
2161   - encoded in a multipart/form-data body. The first thing to do is to find the
2162   - boundary. The boundary is a special string which delimits the various parts of the
2163   - 'multipart' body. It is found within the value of the 'Content-Type' HTTP header, as
2164   - the value of the 'boundary' attribute.
2165   -
2166   -
2167   -
2168   -
2169   -
2170   - *** [5.7.1] Finding the boundary.
2171   -
2172   - Hence, we just have to find the string 'boundary=' within the value of the
2173   - 'Content-Type' header, and read the value of the boundary from there.
2174   -
2175   -define Bool
2176   - delimits_boundary
2177   - (
2178   - Word8 c
2179   - ) =
2180   - if c = ' ' then true else
2181   - if c = 13 then true else
2182   - if c = 10 then true else
2183   - if c = 0 then true else
2184   - if c = ',' then true else
2185   - c = ';'.
2186   -
2187   -
2188   -define Maybe(String)
2189   - get_boundary_value_3
2190   - (
2191   - String s,
2192   - Int32 i,
2193   - List(Word8) so_far
2194   - ) =
2195   - if nth(i,s) is
2196   - {
2197   - failure then success(implode(reverse(so_far))),
2198   - success(c) then
2199   - if delimits_boundary(c)
2200   - then success(implode(reverse(so_far)))
2201   - else get_boundary_value_3(s,i+1,[c . so_far])
2202   - }.
2203   -
2204   -
2205   -
2206   -define Maybe(String)
2207   - get_boundary_value_2
2208   - (
2209   - String s,
2210   - Int32 i,
2211   - ) =
2212   - if nth(i,s) is
2213   - {
2214   - failure then failure,
2215   - success(c) then
2216   - if is_blank(c)
2217   - then get_boundary_value_2(s,i+1)
2218   - else get_boundary_value_3(s,i+1,[c])
2219   - }.
2220   -
2221   -define Maybe(String)
2222   - get_boundary_value_1
2223   - (
2224   - String s, // string into which we must find '= ...'
2225   - Int32 i // position of start of search
2226   - ) =
2227   - if nth(i,s) is
2228   - {
2229   - failure then failure,
2230   - success(c) then
2231   - if is_blank(c)
2232   - then get_boundary_value_1(s,i+1)
2233   - else if c = '='
2234   - then get_boundary_value_2(s,i+1)
2235   - else failure
2236   - }.
2237   -
2238   -
2239   -define Maybe(String)
2240   - get_boundary
2241   - (
2242   - String content_type_header_value
2243   - ) =
2244   - if find("boundary",content_type_header_value,0) is
2245   - {
2246   - failure then failure,
2247   - success(n) then // 'boundary' has been found at position n
2248   - get_boundary_value_1(content_type_header_value,n+8)
2249   - }.
2250   -
2251   -define Maybe(String)
2252   - get_boundary
2253   - (
2254   - List(HTTP_header) headers
2255   - ) =
2256   - if headers is
2257   - {
2258   - [ ] then failure,
2259   - [h . t] then if h is http_header(name,value) then
2260   - if name = "content-type"
2261   - then get_boundary(value)
2262   - else get_boundary(t)
2263   - }.
2264   -
2265   -
2266   -
2267   -
2268   -
2269   -
2270   -
2271   -
2272   - *** [5.7.2] Reading attributes from a multipart entity.
2273   -
2274   - Entities in a multipart/form-data body are separated by instances of the string:
2275   -
2276   - --bbbbb
2277   -
2278   - where bbbbb is the boundary computed above. Actually, the body has the form:
2279   -
2280   - --bbbbb
2281   - <entity 1>
2282   - --bbbbb
2283   - <entity 2>
2284   - --bbbbb
2285   - ...
2286   - --bbbbb
2287   - <last entity>
2288   - --bbbbb
2289   -
2290   -
2291   - We have to extract an entity which is in the body between offsets 'start' and 'end'
2292   - (computed when boundaries have been localized). The entity itself is made of two parts:
2293   - headers and body. The body is separated from the headers by a blank line. This blank
2294   - line (a double crlf) marks the beginning of the body of the entity. Within the headers
2295   - of the entity, we look for a 'Content-Disposition' header, which should look like this:
2296   -
2297   - Content-Disposition: form-data; name="..."; filename="..." crlf
2298   -
2299   - We are just interested in the name and the file name. Hence we first search
2300   - 'Content-Disposition', then we search 'name' and read the value, and we do the same for
2301   - 'filename'.
2302   -
2303   - If the 'filename' attribute is not present, the web arg is an ordinary one, otherwise,
2304   - it is an uploaded file.
2305   -
2306   -
2307   - Below is a variant of 'find' (see 'tools/findstring.anubis'), with an extra 'end'
2308   - argument.
2309   -
2310   -define Maybe(Int32)
2311   - find
2312   - (
2313   - String what,
2314   - ByteArray where,
2315   - Int32 start,
2316   - Int32 end
2317   - ) =
2318   - if find(to_byte_array(what),where,start) is
2319   - {
2320   - failure then failure,
2321   - success(n) then
2322   - if n+length(what) >= end
2323   - then failure
2324   - else success(n)
2325   - }.
2326   -
2327   -
2328   -define String
2329   - read_attribute_value
2330   - (
2331   - ByteArray where,
2332   - Int32 start,
2333   - Int32 end,
2334   - List(Word8) so_far
2335   - ) =
2336   - if start >= end then implode(reverse(so_far)) else
2337   - if nth(start,where) is
2338   - {
2339   - failure then implode(reverse(so_far)),
2340   - success(c) then
2341   - if c = '\"'
2342   - then implode(reverse(so_far))
2343   - else read_attribute_value(where,start+1,end,[c . so_far])
2344   - }.
2345   -
2346   -define Maybe(String)
2347   - find_attribute
2348   - (
2349   - String name,
2350   - ByteArray where,
2351   - Int32 start,
2352   - Int32 end
2353   - ) =
2354   - with name = name+"=\"",
2355   - if find(to_byte_array(name),where,start) is
2356   - {
2357   - failure then failure,
2358   - success(n) then
2359   - if n+length(name) >= end
2360   - then failure
2361   - else success(read_attribute_value(where,n+length(name),end,[]))
2362   - }.
2363   -
2364   -
2365   -
2366   -define Maybe((String,Maybe(String)))
2367   - find_name_and_filename
2368   - (
2369   - ByteArray body,
2370   - Int32 start,
2371   - Int32 end
2372   - ) =
2373   - if find(to_byte_array("Content-Disposition"),body,start) is
2374   - {
2375   - failure then failure,
2376   - success(n) then
2377   - if find_attribute("name",body,n+19,end) is
2378   - {
2379   - failure then failure,
2380   - success(name_value) then if find_attribute("filename",body,n+19,end) is
2381   - {
2382   - failure then success((name_value,failure)),
2383   - success(filename_value) then success((name_value,success(filename_value)))
2384   - }
2385   - }
2386   - }.
2387   -
2388   -
2389   -
2390   -
2391   -
2392   -
2393   -
2394   -
2395   -
2396   -
2397   - *** [5.7.3] Creating a temporary filename for an uploaded file.
2398   -
2399   -variable Int32 uploaded_file_count = 0.
2400   -
2401   - This variable is local to the virtual machine. Hence, its value is 0 each time a new
2402   - requests arrives. Temporary uploaded files are stored in the directory represented by
2403   - 'upload_temporary_directory'. The filenames have the form:
2404   -
2405   - _m_n
2406   -
2407   - where 'm' is the number of the virtual machine, and 'n' a number obtained by
2408   - incrementing 'uploaded_file_count'. Notice that the program must do something with this
2409   - file (move it to some directory/name), otherwise, it will probably be overwritten the
2410   - next time the same machine works.
2411   -
2412   -
2413   -
2414   -
2415   -
2416   -
2417   - *** [5.7.4] Saving an uploaded file under a temporary filename.
2418   -
2419   -define Maybe(String) // returns the temporary file name
2420   - save_uploaded_file
2421   - (
2422   - Web_Site_Description desc,
2423   - ByteArray body,
2424   - Int32 start,
2425   - Int32 end
2426   - ) =
2427   - uploaded_file_count <- 1 + *uploaded_file_count;
2428   - with tfn = "_"+integer_to_string(virtual_machine_id)+"_"+integer_to_string(*uploaded_file_count),
2429   - if (Maybe(WStream))connect to file site_directory(desc)+"/upload_temporary/"+tfn is
2430   - {
2431   - failure then failure,
2432   - success(f) then
2433   - if reliable_write(file(f),extract(body,start,end)) is
2434   - {
2435   - failure then failure,
2436   - success(nw) then
2437   - if nw = end - start
2438   - then success(tfn)
2439   - else failure
2440   - }
2441   - }.
2442   -
2443   -
2444   -
2445   -
2446   -
2447   -
2448   -
2449   -
2450   - *** [5.7.5] Removing the path from a file name.
2451   -
2452   - When a file is uploaded, the browser sends the complete path of the file on the client
2453   - machine as the file name. Actually, this is not quite normal. Nevertheless, we need to
2454   - remove the path, and keep only the file name. This is achieved by 'remove_path' below.
2455   -
2456   -define Int32
2457   - file_name_begin
2458   - (
2459   - String full_name,
2460   - Int32 i
2461   - ) =
2462   - if nth(i,full_name) is
2463   - {
2464   - failure then 0,
2465   - success(c) then
2466   - if c = '/' then i+1 else
2467   - if c = '\\' then i+1 else
2468   - file_name_begin(full_name,i-1)
2469   - }.
2470   -
2471   -define String
2472   - remove_path
2473   - (
2474   - String full_name
2475   - ) =
2476   - with l = length(full_name),
2477   - b = file_name_begin(full_name,l-1),
2478   - substr(full_name,b,l-b).
2479   -
2480   -
2481   -
2482   -
2483   -
2484   - *** [5.7.6] Reading a multipart entity.
2485   -
2486   -define Maybe(Web_arg)
2487   - get_multipart_entity
2488   - (
2489   - Web_Site_Description desc,
2490   - ByteArray body,
2491   - Int32 start,
2492   - Int32 end
2493   - ) =
2494   - if find(to_byte_array(crlf+crlf),body,start) is
2495   - {
2496   - failure then failure,
2497   - success(k) then
2498   - if k >= end // must be within this entity, not the next one
2499   - then failure
2500   - else if find_name_and_filename(body,start,k) is
2501   - {
2502   - failure then failure,
2503   - success(n_mbfn) then if n_mbfn is (name,mbfn) then
2504   - if mbfn is
2505   - {
2506   - failure then
2507   - success(web_arg(name,to_string(extract(body,k+4,end-2)))),
2508   - // we must substract 2 to end because of crlf just before the boundary
2509   -
2510   - success(fn) then
2511   - if save_uploaded_file(desc,body,k+4,end-2) is
2512   - {
2513   - failure then failure,
2514   - success(tfn) then
2515   - success(upload(name,remove_path(fn),
2516   - site_directory(desc)+"/upload_temporary/"+tfn))
2517   -
2518   - }
2519   - }
2520   - }
2521   - }.
2522   -
2523   -
2524   -
2525   -define List(Web_arg)
2526   - read_multipart_form_data_encoded_web_args
2527   - (
2528   - Web_Site_Description desc,
2529   - ByteArray body,
2530   - ByteArray __boundary,
2531   - Int32 i,
2532   - ) =
2533   - if find(__boundary,body,i) is
2534   - {
2535   - failure then [ ],
2536   - success(n) then
2537   - if find(__boundary,body,n+length(__boundary)) is
2538   - {
2539   - failure then [ ],
2540   - success(m) then
2541   - if get_multipart_entity(desc,body,n+length(__boundary),m) is
2542   - {
2543   - failure then [ ],
2544   - success(wa) then
2545   - [wa . read_multipart_form_data_encoded_web_args(desc,body,__boundary,m)]
2546   - }
2547   - }
2548   - }.
2549   -
2550   -
2551   -
2552   -define One
2553   - multipart_form_data_answer
2554   - (
2555   - String host_name,
2556   - Web_Site_Description desc,
2557   - Connection connection,
2558   - Int32 ip_addr,
2559   - HTTP_RequestLine request_line,
2560   - List(HTTP_header) headers,
2561   - ByteArray body,
2562   - One -> String generate_tt
2563   - ) =
2564   - if get_boundary(headers) is
2565   - {
2566   - failure then unique,
2567   - success(boundary) then
2568   - with all_web_args = query_string(request_line) +
2569   - read_multipart_form_data_encoded_web_args(desc,
2570   - body,
2571   - to_byte_array("--"+boundary),
2572   - 0),
2573   - uri = uri(request_line),
2574   - ext = get_uri_extension(uri),
2575   - log_journal_msg(desc,
2576   - format_request(desc,connection,request_line,headers,all_web_args));
2577   - if is_illegal_uri(uri,0)
2578   - then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
2579   - else
2580   - if (ext = ".awp" | ext = "") then
2581   - (with answer_headers_body = awp_handler(desc)(host_name,
2582   - http_info(ip_addr,uri,headers,generate_tt),
2583   - all_web_args,
2584   - is_SSL(connection)),
2585   - if answer_headers_body is (additional_headers,answer_body) then
2586   - forget(reliable_write(connection,
2587   - [ "HTTP/1.1 200 OK",crlf,
2588   - format_headers(standard_headers(length(answer_body),charset(desc))),
2589   - format_headers(additional_headers),
2590   - crlf .
2591   - answer_body])))
2592   - else unique
2593   - }.
2594   -
2595   -
2596   -
2597   -
2598   -
2599   -
2600   -
2601   -
2602   - *** [5.8] Handling redirections.
2603   -
2604   - 'redirections' (of type 'List(Redirection)') contains redirection directives. Each one
2605   - has the form:
2606   -
2607   - redirect(required_uri,required_host,corresponding_uri).
2608   -
2609   - The host required by the client may be found in the 'Host' HTTP header. The URI
2610   - required by the client is given below as 'uri'. We just have to find the required host
2611   - in the headers, and to find the corresponding redirection directive.
2612   -
2613   -
2614   - In the next fonction, the required host and URI are known. We just have to search in
2615   - the 'redirections' list.
2616   -
2617   -define String
2618   - handle_redirection
2619   - (
2620   - String required_uri,
2621   - String required_host,
2622   - List(Redirection) redirections
2623   - ) =
2624   - if redirections is
2625   - {
2626   - [ ] then required_uri,
2627   - [h . t] then if h is redirect(uri,host,target) then
2628   - if host = required_host
2629   - then if uri = required_uri
2630   - then target
2631   - else handle_redirection(required_uri,required_host,t)
2632   - else handle_redirection(required_uri,required_host,t)
2633   - }.
2634   -
2635   -
2636   -
2637   - The host name may be encumbered by a port number, like
2638   -
2639   - www.our-business.com:1607
2640   -
2641   - We must remove this port number, otherwise the host name may not be recognized.
2642   -
2643   -define String
2644   - strip_port
2645   - (
2646   - String name,
2647   - Int32 i
2648   - ) =
2649   - if nth(i,name) is
2650   - {
2651   - failure then name,
2652   - success(c) then
2653   - if c = ':'
2654   - then substr(name,0,i)
2655   - else strip_port(name,i+1)
2656   - }.
2657   -
2658   -
2659   -
2660   -
2661   -
2662   - Finding the 'Host' header. No redirection is performed if this header is not found.
2663   -
2664   -define String
2665   - handle_redirection // returns the redirected URI
2666   - (
2667   - List(Redirection) redirections,
2668   - String uri, // original URI
2669   - List(HTTP_header) headers
2670   - ) =
2671   - if headers is
2672   - {
2673   - [ ] then uri,
2674   - [h . t] then if h is http_header(name,value) then
2675   - if name = "host"
2676   - then handle_redirection(uri,strip_port(value,0),redirections)
2677   - else handle_redirection(redirections,uri,t)
2678   - }.
2679   -
2680   -
2681   -
2682   -
2683   -
2684   -
2685   -
2686   -
2687   - *** [5.9] Answering both sorts of requests.
2688   -
2689   - We must decide if the request is www-url encoded or multipart/form-data encoded. This
2690   - is achieved through the header 'Content-Type'.
2691   -
2692   -define EncodingType
2693   - get_encoding_type
2694   - (
2695   - List(HTTP_header) headers
2696   - ) =
2697   - if headers is
2698   - {
2699   - [ ] then www_url, // this is the default
2700   - [h . t] then if h is http_header(name,value) then
2701   - if name = "content-type"
2702   - then if find("multipart/form-data",value,0) is
2703   - {
2704   - failure then www_url,
2705   - success(_) then multipart_form_data
2706   - }
2707   - else get_encoding_type(t)
2708   - }.
2709   -
2710   -
2711   -
2712   -define One
2713   - send_answer
2714   - (
2715   - String host_name,
2716   - Web_Site_Description desc,
2717   - Connection connection,
2718   - HTTP_RequestLine rqline,
2719   - List(HTTP_header) headers,
2720   - ByteArray body,
2721   - One -> String generate_tt
2722   - ) =
2723   - if rqline is request_line(type,uri,qstring) then
2724   - with rqline = request_line(type,handle_redirection(redirections(desc),uri,headers),qstring),
2725   - if remote_IP_address_and_port(connection) is (ip_addr,_) then
2726   - if get_encoding_type(headers) is
2727   - {
2728   - www_url then
2729   - www_url_answer(host_name,desc,connection,ip_addr,rqline,headers,body,generate_tt),
2730   - multipart_form_data then
2731   - multipart_form_data_answer(host_name,desc,connection,ip_addr,rqline,headers,body,generate_tt)
2732   - }.
2733   -
2734   -
2735   -
2736   -
2737   -
2738   -
2739   -
2740   - *** [6] The HTTP/HTTPS server.
2741   -
2742   - The command 'start_server' (declared in 'predefined.anubis') starts a virtual machine
2743   - which opens a server TCP/IP connection, and which continuously listens to this
2744   - connection. When a request arrives, this machine delegates the work of deciphering and
2745   - answering the request to another virtual machine, and continues to listen. The job of
2746   - the delegated machine is defined by the HTTP request handler below.
2747   -
2748   -
2749   -
2750   -
2751   -
2752   - *** [6.1] Determining the requested host.
2753   -
2754   - When a request arrives to one of our two servers, we must decide which site (host) is
2755   - requested.
2756   -
2757   -define Maybe(String)
2758   - get_host_header_value
2759   - (
2760   - List(HTTP_header) headers
2761   - ) =
2762   - if headers is
2763   - {
2764   - [ ] then failure,
2765   - [h . t] then if h is http_header(name,value) then
2766   - if name = "host"
2767   - then success(strip_port(value,0))
2768   - else get_host_header_value(t)
2769   - }.
2770   -
2771   -define Maybe((String,Web_Site_Description))
2772   - get_site
2773   - (
2774   - String requested_host,
2775   - List(Web_Site_Description) sites
2776   - ) =
2777   - if sites is
2778   - {
2779   - [ ] then print("Requested host '"+requested_host+"' does not exist.\n"); failure,
2780   - [site1 . others] then
2781   - if site1 is web_site_description(common_names,_,_,_,_,_,_,_,_,_) then
2782   - if member(common_names,requested_host)
2783   - then success((requested_host,site1))
2784   - else get_site(requested_host,others)
2785   - }.
2786   -
2787   -
2788   -define Maybe((String,Web_Site_Description))
2789   - get_site
2790   - (
2791   - List(HTTP_header) headers,
2792   - List(Web_Site_Description) sites
2793   - ) =
2794   - if get_host_header_value(headers) is
2795   - {
2796   - failure then print("No 'Host' HTTP header.\n"); failure,
2797   - success(requested_host) then
2798   - //here we treat the case with only one site. hence we accept any host request
2799   - //print("*** there is " +length(sites) + " sites \n");
2800   - if length(sites) = 1 then
2801   - with site = force_nth(0, sites),
2802   - //print("ONE server OK\n");
2803   - success((requested_host, site))
2804   - else
2805   - get_site(requested_host,sites)
2806   - }.
2807   -
2808   -
2809   -
2810   -
2811   -
2812   - *** [6.2] The HTTP request handler.
2813   -
2814   - Here is the HTTP/HTTPS handler. It is called at each new request in a separate virtual
2815   - machine. It reads the headers of the HTTP request, determines the host, determines body
2816   - size, reads the body of the HTTP request, and answers the request.
2817   -
2818   -
2819   -
2820   -define One -> String make_generate_trust_ticket(DenialOfService dos).
2821   -
2822   -
2823   -define One
2824   - http_https_handler
2825   - (
2826   - List(Web_Site_Description) sites,
2827   - Connection connection,
2828   - Bool is_https,
2829   - DenialOfService dos
2830   - ) =
2831   - with start_time = (Int32)now,
2832   - sttm <- start_time;
2833   - if dos is denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
2834   - if remote_IP_address_and_port(connection) is (ip_addr,port) then
2835   - if read_request_line(connection,start_time+*rld_v,dos) is
2836   - {
2837   - error(msg) then print(format(msg)),
2838   - ok(request_line) then
2839   - if read_http_headers(connection,start_time+*hd_v,dos) is
2840   - {
2841   - error(msg) then print(format(msg)),
2842   - ok(headers) then if get_site(headers,sites) is
2843   - {
2844   - failure then unique,
2845   - success(p) then if p is (host_name,desc) then
2846   - if get_body_size(headers) is
2847   - {
2848   - error(msg) then log_journal_msg(desc,format(msg)),
2849   - ok(body_size) then
2850   - if read_http_body(connection,body_size,constant_byte_array(0,0),1000) is
2851   - {
2852   - error(msg) then log_journal_msg(desc,format(msg)),
2853   - ok(body) then
2854   - send_answer(host_name,desc,connection,request_line,headers,body,
2855   - make_generate_trust_ticket(dos))
2856   - }
2857   - }
2858   - }
2859   - }
2860   - }.
2861   -
2862   -
2863   - Below are the two tools for constructing the handlers required by 'start_server' and
2864   - 'start_ssl_server' (see 'predefined.anubis').
2865   -
2866   -define Bool is_dubious_IP(Int32 ip, DenialOfService dos).
2867   -
2868   -define Server -> ((RWStream) -> One)
2869   - make_http_handler
2870   - (
2871   - List(Web_Site_Description) sites,
2872   - DenialOfService dos
2873   - ) =
2874   - (Server server) |-> (RWStream connection) |->
2875   - if remote_IP_address_and_port(connection) is (addr,_) then
2876   - if is_dubious_IP(addr,dos)
2877   - then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
2878   - else http_https_handler(sites,tcp(connection),false,dos).
2879   -
2880   -define Server -> (SSL_Connection -> One)
2881   - make_https_handler
2882   - (
2883   - List(Web_Site_Description) sites,
2884   - DenialOfService dos
2885   - ) =
2886   - (Server server) |-> (SSL_Connection connection) |->
2887   - http_https_handler(sites,ssl(connection),true,dos).
2888   -
2889   -
2890   -
2891   -
2892   - *** [6.3] Server's tasks.
2893   -
2894   - Some tasks must be executed periodically, for example for cleaning up directories from
2895   - short life time files.
2896   -
2897   - The next function removes from the given directory (and recursively from its
2898   - subdirectories) all the files which are more than 10 minutes old.
2899   -
2900   -define One
2901   - cleanup_directory_10mn
2902   - (
2903   - String dir // path of private download directory (or subdirectory) with trailing slash
2904   - ) =
2905   - forget(map((FileDescription fd) |-> if fd is
2906   - {
2907   - no_info(name) then forget(remove(dir+name)),
2908   - file(name,_,_,d) then if d+600 < now then forget(remove(dir+name)) else unique,
2909   - link(name,_,_,d) then if d+600 < now then forget(remove(dir+name)) else unique,
2910   - directory(name,_,_) then cleanup_directory_10mn(dir+name+"/"),
2911   - },
2912   - directory_full_list(dir,"*","*","*"))).
2913   -
2914   -
2915   -define One
2916   - http_servers_tasks
2917   - (
2918   - List(Web_Site_Description) sites,
2919   - List(Server) servers,
2920   - Int32 period,
2921   - Int32 next_time,
2922   - ) =
2923   - if mapand(is_down,servers)
2924   - then unique
2925   - else if now > next_time
2926   - then
2927   - (
2928   - /*
2929   - forget(map((Web_Site_Description wsd) |->
2930   - cleanup_directory_10mn(site_directory(wsd)+"/private_download/"),
2931   - sites));
2932   - */
2933   - http_servers_tasks(sites,servers,period,next_time+period)
2934   - )
2935   - else
2936   - (
2937   - sleep(1000);
2938   - http_servers_tasks(sites,servers,period,next_time)
2939   - ).
2940   -
2941   -
2942   -public define One
2943   - start_http_servers_tasks
2944   - (
2945   - List(Web_Site_Description) sites,
2946   - List(Server) servers,
2947   - Int32 period
2948   - ) =
2949   - delegate http_servers_tasks(sites,servers,period,now),
2950   - unique.
2951   -
2952   -
2953   -
2954   -
2955   - *** [6.4] Protection against 'denial of service' attacks.
2956   -
2957   -
2958   - *** [6.4.1] Counting connections.
2959   -
2960   -define Bool // returns false if the counter cannot be incremented (too many connections)
2961   - increment_connections_counter
2962   - (
2963   - Var(Int32) counter
2964   - ) =
2965   - protect with n = *counter,
2966   - if n >= 100
2967   - then false
2968   - else (counter <- (*counter)+1); true.
2969   -
2970   -define One
2971   - decrement_connections_counter
2972   - (
2973   - Var(Int32) counter
2974   - ) =
2975   - protect counter <- (*counter)-1.
2976   -
2977   -
2978   -
2979   -
2980   -
2981   - *** [6.4.2] Recording dubious IP addresses.
2982   -
2983   -
2984   -define List(DubiousIP)
2985   - record_dubious_IP
2986   - (
2987   - Int32 ip,
2988   - List(DubiousIP) l
2989   - ) =
2990   - if l is
2991   - {
2992   - [ ] then [dubious_ip(ip,now)],
2993   - [h . t] then if h is dubious_ip(addr,time) then
2994   - if addr = ip
2995   - then [dubious_ip(addr,now) . t]
2996   - else [h . record_dubious_IP(ip,t)]
2997   - }.
2998   -
2999   -
3000   -define One
3001   - record_dubious_IP
3002   - (
3003   - Int32 dubious_IP,
3004   - Var(List(DubiousIP)) v
3005   - ) =
3006   - protect v <- record_dubious_IP(dubious_IP,*v).
3007   -
3008   -
3009   -define One
3010   - record_dubious_IP
3011   - (
3012   - Int32 addr,
3013   - DenialOfService dos
3014   - ) =
3015   - record_dubious_IP(addr,list_of_dubious(dos)).
3016   -
3017   -
3018   -public define DenialOfService
3019   - load_denial_of_service_info
3020   - =
3021   - if (RetrieveResult(DenialOfService))retrieve(my_anubis_directory+"/web_sites/dos_info") is
3022   - ok(dos) then dos else denial_of_service(
3023   - var(100),
3024   - var(1000),
3025   - var(1500),
3026   - var(2000),
3027   - var([]),
3028   - var([])).
3029   -
3030   -
3031   -
3032   -
3033   - *** [6.4.3] Testing if an address is dubious.
3034   -
3035   -define Bool
3036   - is_dubious_IP
3037   - (
3038   - Int32 ip,
3039   - List(DubiousIP) l
3040   - ) =
3041   - if l is
3042   - {
3043   - [ ] then false,
3044   - [h . t] then if h is dubious_ip(addr,time) then
3045   - if ip = addr
3046   - then true
3047   - else is_dubious_IP(ip,t)
3048   - }.
3049   -
3050   -
3051   -define Bool
3052   - is_dubious_IP
3053   - (
3054   - Int32 ip,
3055   - DenialOfService dos
3056   - ) =
3057   - if dos is
3058   - {
3059   - denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
3060   - if member(*ra_v,ip) then false else
3061   - is_dubious_IP(ip,*ld_v)
3062   - }.
3063   -
3064   -
3065   -
3066   -
3067   - *** [6.4.4] Removing inactive dubious IP addresses.
3068   -
3069   -define List(DubiousIP)
3070   - remove_inactive_dubious_IP
3071   - (
3072   - List(DubiousIP) l,
3073   - Int32 ref_time,
3074   - ) =
3075   - if l is
3076   - {
3077   - [ ] then [ ],
3078   - [h . t] then if h is dubious_ip(addr,time) then
3079   - if time < ref_time
3080   - then (print(ip_addr_to_string(addr)+" removed from dubious addresses list.\n");
3081   - remove_inactive_dubious_IP(t,ref_time))
3082   - else [h . remove_inactive_dubious_IP(t,ref_time)]
3083   - }.
3084   -
3085   -define One
3086   - remove_inactive_dubious_IP
3087   - (
3088   - Var(List(DubiousIP)) v
3089   - ) =
3090   - protect
3091   - with ref_time = now - 600, // 10 minutes
3092   - v <- remove_inactive_dubious_IP(*v,ref_time).
3093   -
3094   -
3095   - The above function will be executed periodically by the servers's tasks machine.
3096   -
3097   -
3098   -
3099   - *** [6.4.5] Making the function for generating trust tickets.
3100   -
3101   -define One -> String
3102   - make_generate_trust_ticket
3103   - (
3104   - DenialOfService dos
3105   - ) =
3106   - (One _) |-> "".
3107   -
3108   -
3109   -
3110   -
3111   -
3112   -
3113   -
3114   - *** [6.5] Starting the HTTP/HTTPS server.
3115   -
3116   -
3117   - The next function creates the directories for all sites (if they don't already exist).
3118   -
3119   -define One
3120   - create_directories
3121   - (
3122   - List(Web_Site_Description) sites
3123   - ) =
3124   - if sites is
3125   - {
3126   - [ ] then unique,
3127   - [s1 . others] then
3128   - with site_dir = site_directory(s1),
3129   - forget(make_directory(site_dir+"/public",default_directory_mode));
3130   - forget(make_directory(site_dir+"/upload_temporary",default_directory_mode));
3131   - forget(make_directory(site_dir+"/private_download",default_directory_mode));
3132   - forget(make_directory(site_dir+"/journal",default_directory_mode));
3133   - create_directories(others)
3134   - }.
3135   -
3136   -
3137   -
3138   -
3139   -
3140   - Below are the commands for starting an HTTP server and an HTTPS server.
3141   -
3142   -
3143   -define StartServerResult
3144   - start_http_server
3145   - (
3146   - Int32 ip_address,
3147   - Int32 port,
3148   - Server -> ((RWStream) -> One) handler,
3149   - Int32 retries,
3150   - DenialOfService dos
3151   - ) =
3152   - if start_server(ip_address,
3153   - port,
3154   - handler,
3155   - identity) is ok(server)
3156   - then print(" \r");
3157   - ok(server)
3158   - else print("Port "+port+": retry number "+retries+"\r");
3159   - sleep(1000);
3160   - start_http_server(ip_address,port,handler,retries+1,dos).
3161   -
3162   -public define StartServerResult
3163   - start_http_server
3164   - (
3165   - Int32 ip_address,
3166   - Int32 port,
3167   - List(Web_Site_Description) sites,
3168   - DenialOfService dos
3169   - ) =
3170   - create_directories(sites);
3171   - start_http_server(ip_address,port,
3172   - make_http_handler(sites,dos),
3173   - 0,
3174   - dos).
3175   -
3176   -
3177   - For the HTTPS server, we have a problem which is due to the fact that 'anbexec' is not
3178   - yet able to manipulate several SSL server certificates. 'anbexec' and
3179   - 'predefined.anubis' must be changed. Sorry ! This will be done as soon as possible. The
3180   - 'solution' for the time being is to provide the common name of the unique SSL server
3181   - certificate.
3182   -
3183   -
3184   -define StartServerResult
3185   - start_https_server
3186   - (
3187   - Int32 ip_address,
3188   - Int32 port,
3189   - String certificate_common_name,
3190   - Server -> (SSL_Connection -> One) handler,
3191   - Int32 retries,
3192   - DenialOfService dos
3193   - ) =
3194   - if start_ssl_server(ip_address,
3195   - port,
3196   - certificate_common_name,
3197   - handler,
3198   - identity) is ok(server)
3199   - then print(" \r");
3200   - ok(server)
3201   - else print("Port "+port+": retry number "+retries+"\r");
3202   - sleep(1000);
3203   - start_https_server(ip_address,port,
3204   - certificate_common_name,
3205   - handler,retries+1,
3206   - dos).
3207   -
3208   -
3209   -public define StartServerResult
3210   - start_https_server
3211   - (
3212   - Int32 ip_address,
3213   - Int32 port,
3214   - String certificate_common_name, // of SSL server certificate
3215   - List(Web_Site_Description) sites,
3216   - DenialOfService dos
3217   - ) =
3218   - create_directories(sites);
3219   - start_https_server(ip_address,port,certificate_common_name,
3220   - make_https_handler(sites,dos),
3221   - 0,dos).
3222   -
3223   -
3224   -
3225   -
3226   -
3227   -
3228   -
3229   -
3230   -
3231   - *** [7] The web dispatcher.
3232   -
3233   -
3234   - *** [7.1] The dispatcher server.
3235   -
3236   -define One
3237   - send_dispatching_page
3238   - (
3239   - RWStream conn,
3240   - String common_name,
3241   - Int32 port
3242   - ) =
3243   - print("Dispatching '"+common_name+"' to port "+port+"\n");
3244   - forget(reliable_write(conn,to_byte_array(
3245   - "<html><head><meta http-equiv=\"Refresh\" content=\"0;URL="+
3246   - "http://"+common_name+":"+port+"/"+
3247   - "\"></head><body></body></html>"
3248   - ))).
3249   -
3250   -
3251   -
3252   -define Maybe(DispatcherInfo)
3253   - find_host
3254   - (
3255   - List(DispatcherInfo) l,
3256   - String host
3257   - ) =
3258   - if l is
3259   - {
3260   - [ ] then failure,
3261   - [h . t] then if h is site(name,port) then
3262   - if name = host
3263   - then success(h)
3264   - else find_host(t,host)
3265   - }.
3266   -
3267   -
3268   -
3269   -define Server -> ((RWStream) -> One)
3270   - make_dispatcher_handler
3271   - (
3272   - Var(List(DispatcherInfo)) info_v,
3273   - DenialOfService dos
3274   - ) =
3275   - (Server server) |-> (RWStream conn) |->
3276   - with start_time = (Int32)now,
3277   - if read_request_line(tcp(conn),start_time+*request_line_delay(dos),dos) is
3278   - {
3279   - error(msg) then print(format(msg)),
3280   - ok(request_line) then
3281   - if read_http_headers(tcp(conn),start_time+*headers_delay(dos),dos) is
3282   - {
3283   - error(msg) then print(format(msg)),
3284   - ok(headers) then if get_host_header_value(headers) is
3285   - {
3286   - failure then print("No 'HOST' HTTP header.\n"),
3287   - success(host) then
3288   - if find_host(*info_v,host) is
3289   - {
3290   - failure then print("Host: '"+host+"' not registered.\n"),
3291   - success(s) then if s is site(common_name,ip_port) then
3292   - send_dispatching_page(conn,common_name,ip_port)
3293   - }
3294   - }
3295   - }
3296   - }.
3297   -
3298   -
3299   -define One
3300   - dispatcher_update_error
3301   - (
3302   - String file_path
3303   - ) =
3304   - print("web_dispatcher: unable to reread file: '"+file_path+"'.\n").
3305   -
3306   -
3307   -define Bool
3308   - dispatcher_update_data
3309   - (
3310   - String info_file_path,
3311   - Var(List(DispatcherInfo)) info_v,
3312   - Var(Int32) info_date_v
3313   - ) =
3314   - if directory_full_list(my_anubis_directory+"/web_sites","dispatcher.info","","") is
3315   - {
3316   - [ ] then false,
3317   - [h . t] then if h is
3318   - {
3319   - no_info(n) then false,
3320   - file(n,_,_,d) then if n = "dispatcher.info"
3321   - then (info_date_v <- d;
3322   - if (RetrieveResult(List(DispatcherInfo)))retrieve(info_file_path) is
3323   - {
3324   - cannot_find_file then false,
3325   - read_error then false,
3326   - type_error then false,
3327   - ok(info) then info_v <- info; true
3328   - })
3329   - else false,
3330   - link(_,_,_,_) then false,
3331   - directory(_,_,_) then false
3332   - }
3333   - }.
3334   -
3335   -
3336   -
3337   - The loop within which the dispatcher updates its data every 3 seconds:
3338   -
3339   -define One
3340   - dispatcher_update_task
3341   - (
3342   - String info_file_path,
3343   - Var(List(DispatcherInfo)) info_v,
3344   - Var(Int32) info_date_v
3345   - ) =
3346   - sleep(3000);
3347   - (if dispatcher_update_data(info_file_path,info_v,info_date_v)
3348   - then unique
3349   - else dispatcher_update_error(info_file_path));
3350   - dispatcher_update_task(info_file_path,info_v,info_date_v).
3351   -
3352   -
3353   -public define One
3354   - start_web_dispatcher
3355   - (
3356   - Int32 ip_address, // address for listening (typically 0: listen on all interfaces)
3357   - Int32 http_port, // typically 80
3358   - DenialOfService dos
3359   - ) =
3360   - with info_file_path = my_anubis_directory+"/web_sites/dispatcher.info",
3361   - info_v = var((List(DispatcherInfo))[]),
3362   - info_date_v = var((Int32)0),
3363   - if dispatcher_update_data(info_file_path,info_v,info_date_v)
3364   - then if start_server(ip_address,
3365   - http_port,
3366   - make_dispatcher_handler(info_v,dos),
3367   - (One u)|->u) is
3368   - {
3369   - cannot_create_the_socket then
3370   - print("Cannot create the socket for HTTP server.\n"),
3371   - cannot_bind_to_port then
3372   - print("Cannot bind HTTP server to port "+http_port+".\n"),
3373   - cannot_listen_on_port then
3374   - print("HTTP server cannot listen on port "+http_port+".\n"),
3375   - ok(http_server) then
3376   - dispatcher_update_task(info_file_path,info_v,info_date_v)
3377   - }
3378   - else dispatcher_update_error(info_file_path).
3379   -
3380   -
3381   -
3382   - *** [7.2] The dispatcher web site.
3383   -
3384   -global define One
3385   - web_dispatcher
3386   - (
3387   - List(String) args
3388   - ) =
3389   - start_web_dispatcher(0,80,load_denial_of_service_info).
3390   -
3391   -
3392   -
3393   -
3394   -
3395   -
3396   - *** [7.3] Managing the info file.
3397   -
3398   -define Int32
3399   - register_ip_address
3400   - =
3401   - if ip_address(prompt(" numerical IP address (for HTTP): ")) is
3402   - {
3403   - failure then print(" *** Error: incorrect IP address.\n");
3404   - register_ip_address,
3405   - success(n) then n
3406   - }.
3407   -
3408   -
3409   -define Int32
3410   - register_ip_port
3411   - =
3412   - if string_to_integer(prompt(" IP port (for HTTP): ")) is
3413   - {
3414   - failure then print(" *** Error: incorrect IP port.\n");
3415   - register_ip_port,
3416   - success(p) then if (0 =< p & p =< 65535)
3417   - then p
3418   - else print(" *** Error: IP port out of bounds.\n");
3419   - register_ip_port
3420   - }.
3421   -
3422   -
3423   -define One
3424   - register_new_site
3425   - (
3426   - Var(List(DispatcherInfo)) info_v
3427   - ) =
3428   - print("\n");
3429   - print(" Registering a new site:\n");
3430   - with name = prompt(" Site name: "),
3431   - with addr = register_ip_address,
3432   - with port = register_ip_port,
3433   - (protect info_v <- [site(name,port) . *info_v]);
3434   - print(" Site "+name+" at "+ip_addr_to_string(addr)+":"+port+" added\n (but not saved to disk).\n").
3435   -
3436   -
3437   -define List(DispatcherInfo)
3438   - find_sites
3439   - (
3440   - List(DispatcherInfo) l,
3441   - String name
3442   - ) =
3443   - if l is
3444   - {
3445   - [ ] then [ ],
3446   - [h . t] then if h is site(n,_) then
3447   - if find(name,n,0) is
3448   - {
3449   - failure then find_sites(t,name),
3450   - success(_) then [h . find_sites(t,name)]
3451   - }
3452   - }.
3453   -
3454   -
3455   -define String
3456   - pad
3457   - (
3458   - String s,
3459   - Int32 l
3460   - ) =
3461   - if length(s) >= l
3462   - then s
3463   - else s+constant_string(l-length(s),' ').
3464   -
3465   -
3466   -
3467   -define One
3468   - show_sites_1
3469   - (
3470   - List(DispatcherInfo) l,
3471   - Int32 i
3472   - ) =
3473   - if l is
3474   - {
3475   - [ ] then unique,
3476   - [h . t] then if h is site(name,port) then
3477   - print(" ["+i+"] "+pad(name,40)+" "+" "+port+"\n");
3478   - show_sites_1(t,i+1)
3479   - }.
3480   -
3481   -
3482   -define One
3483   - show_sites
3484   - (
3485   - List(DispatcherInfo) l,
3486   - Int32 i
3487   - ) =
3488   - print(" Name Port\n");
3489   - print(" --------------------------------------------------------\n");
3490   - show_sites_1(l,i).
3491   -
3492   -define List(DispatcherInfo)
3493   - replace_info
3494   - (
3495   - List(DispatcherInfo) l,
3496   - String site_name,
3497   - Int32 new_port
3498   - ) =
3499   - if l is
3500   - {
3501   - [ ] then alert,
3502   - [h . t] then if h is site(n,_) then
3503   - if n = site_name
3504   - then [site(n,new_port) . t]
3505   - else [h . replace_info(t,site_name,new_port)]
3506   - }.
3507   -
3508   -define List(DispatcherInfo)
3509   - delete_info
3510   - (
3511   - List(DispatcherInfo) l,
3512   - String site_name,
3513   - ) =
3514   - if l is
3515   - {
3516   - [ ] then alert,
3517   - [h . t] then if h is site(n,_) then
3518   - if n = site_name
3519   - then t
3520   - else [h . delete_info(t,site_name)]
3521   - }.
3522   -
3523   -
3524   -define One
3525   - update_site
3526   - (
3527   - Var(List(DispatcherInfo)) info_v,
3528   - String site_name,
3529   - Int32 old_port
3530   - ) =
3531   - print("\n");
3532   - print(" Updating site '"+site_name+"': (currently: "+old_port+")\n");
3533   - with new_port = register_ip_port,
3534   - answer = prompt(" Update '"+site_name+"' as: "+new_port+" [Y/N] ? "),
3535   - if (answer = "Y" | answer = "y")
3536   - then info_v <- replace_info(*info_v,site_name,new_port)
3537   - else unique.
3538   -
3539   -
3540   -
3541   -define Bool
3542   - compare
3543   - (
3544   - DispatcherInfo d1,
3545   - DispatcherInfo d2
3546   - ) =
3547   - if d1 is site(n1,_) then
3548   - if d2 is site(n2,_) then
3549   - string_less(n1,n2).
3550   -
3551   -
3552   -
3553   -define One
3554   - update_site
3555   - (
3556   - Var(List(DispatcherInfo)) info_v
3557   - ) =
3558   - print("\n");
3559   - with prefix = prompt(" Search for site to update: "),
3560   - if find_sites(*info_v,prefix) is
3561   - {
3562   - [ ] then print(" No site found.\n");
3563   - update_site(info_v),
3564   - [h . t] then
3565   - show_sites(qsort([h . t],compare),1);
3566   - with i1 = prompt(" Choose a site to update [1/.../"+(length(t)+1)+"]: "),
3567   - if string_to_integer(i1) is
3568   - {
3569   - failure then print(" *** Error: site number not recognized.\n");
3570   - update_site(info_v),
3571   - success(ii1) then if nth(ii1-1,*info_v) is
3572   - {
3573   - failure then print(" *** Error: site number "+i1+" does not exist.\n");
3574   - update_site(info_v),
3575   - success(site_info) then if site_info is site(name,old_port) then
3576   - update_site(info_v,name,old_port)
3577   - }
3578   - }
3579   - }.
3580   -
3581   -
3582   -define One
3583   - delete_site
3584   - (
3585   - Var(List(DispatcherInfo)) info_v,
3586   - String site_name,
3587   - Int32 old_port
3588   - ) =
3589   - print("\n");
3590   - print(" Deleting site '"+site_name+"': (currently: "+old_port+")\n");
3591   - with answer = prompt(" Are you sure you want to delete site: '"+site_name+"' [Y/N] ? "),
3592   - if (answer = "Y" | answer = "y")
3593   - then info_v <- delete_info(*info_v,site_name)
3594   - else print(" Site '"+site_name+"' not deleted.\n").
3595   -
3596   -
3597   -define One
3598   - delete_site
3599   - (
3600   - Var(List(DispatcherInfo)) info_v
3601   - ) =
3602   - print("\n");
3603   - with prefix = prompt(" Search for site to delete: "),
3604   - if find_sites(*info_v,prefix) is
3605   - {
3606   - [ ] then print(" No site found.\n");
3607   - delete_site(info_v),
3608   - [h . t] then
3609   - show_sites(qsort([h . t],compare),1);
3610   - with i1 = prompt(" Choose a site to delete [1/.../"+(length(t)+1)+"]: "),
3611   - if string_to_integer(i1) is
3612   - {
3613   - failure then print(" *** Error: site number not recognized.\n");
3614   - delete_site(info_v),
3615   - success(ii1) then if nth(ii1-1,*info_v) is
3616   - {
3617   - failure then print(" *** Error: site number "+i1+" does not exist.\n");
3618   - delete_site(info_v),
3619   - success(site_info) then if site_info is site(name,old_port) then
3620   - delete_site(info_v,name,old_port)
3621   - }
3622   - }
3623   - }.
3624   -
3625   -
3626   -define One
3627   - manager
3628   - (
3629   - Var(List(DispatcherInfo)) info_v,
3630   - String file_path
3631   - ) =
3632   - print("\n");
3633   - print(" --- Welcome to the Web Dispatcher Manager ---\n");
3634   - with l = length(*info_v),
3635   - print(" "+l+" site"+(if l>1 then "s" else "")+" currently registred.\n");
3636   - print(" [L] List registered sites.\n");
3637   - print(" [R] Register a new site.\n");
3638   - print(" [U] Update a registred site.\n");
3639   - print(" [D] Delete a registred site.\n");
3640   - with propose_write_v = var((Bool)true),
3641   - action = prompt(" Choose an action [L/R/U/D]: "),
3642   - (if (action = "L" | action = "l") then (show_sites(*info_v,1); propose_write_v <- false) else
3643   - if (action = "R" | action = "r") then register_new_site(info_v) else
3644   - if (action = "U" | action = "u") then update_site(info_v) else
3645   - if (action = "D" | action = "d") then delete_site(info_v) else
3646   - print("Action not recognized.\n"));
3647   - print("\n");
3648   - if *propose_write_v then
3649   - with result = prompt(" Write modifications to data base [Y/N] ?"),
3650   - if (result = "Y" | result = "y")
3651   - then if save(*info_v,file_path) is
3652   - {
3653   - cannot_open_file then print(" File '"+file_path+"' not found.\n"),
3654   - write_error then print(" Error while writing file '"+file_path+"'.\n"),
3655   - ok then print(" Data base has been modified.\n")
3656   - }
3657   - else print(" Data base not modified.\n")
3658   - else unique.
3659   -
3660   -
3661   -
3662   -global define One
3663   - manage_web_dispatcher
3664   - (
3665   - List(String) args
3666   - ) =
3667   - with info_v = var((List(DispatcherInfo))[]),
3668   - with file_path = my_anubis_directory+"/web_sites/dispatcher.info",
3669   - if (RetrieveResult(List(DispatcherInfo)))retrieve(file_path) is
3670   - {
3671   - cannot_find_file then print("File '"+file_path+"' does not exist.\n");
3672   - with answer = prompt("Create it [Y/N] ? "),
3673   - if (answer = "Y" | answer = "y")
3674   - then if save((List(DispatcherInfo))[],file_path) is
3675   - {
3676   - cannot_open_file then
3677   - print("Cannot create file '"+file_path+"'.\n"),
3678   - write_error then
3679   - print("Error while creating file '"+file_path+"'.\n"),
3680   - ok then manager(info_v,file_path)
3681   - }
3682   - else unique,
3683   - read_error then print("Error while reading file '"+file_path+"'.\n"),
3684   - type_error then print("File '"+file_path+"' is corrupted.\n"),
3685   - ok(info) then info_v <- info;
3686   - manager(info_v,file_path)
3687   - }.
3688   -
3689   -
3690   -
3691   -
3692   -
  1 +
  2 + *Project* The Anubis Project
  3 +
  4 + *Title* A Multi Host HTTP/HTTPS Server
  5 +
  6 + *Copyright* Copyright (c) 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 +
... ...