diff --git a/calexium_lib/web/CXM_multihost_http_server.anubis b/calexium_lib/web/CXM_multihost_http_server.anubis
index 6019c62..0143706 100644
--- a/calexium_lib/web/CXM_multihost_http_server.anubis
+++ b/calexium_lib/web/CXM_multihost_http_server.anubis
@@ -1,3692 +1,3695 @@
-
- *Project* The Anubis Project
-
- *Title* A Multi Host HTTP/HTTPS Server
-
- *Copyright* Copyright (c) Alain Prouté 2003.
-
-
- *Author* Alain Prouté
-
-
- *Revised* August 2005.
-
-
-
- *Overviews*
- In this file a HTTP/HTTPS server is defined, which is able to handle multiple hosts
- (virtual hosts). It answers HTTP/HTTPS requests, sends files (images or any other kind
- of file), constructs HTML pages on the fly using informations received from the client
- (when the URI ends by '.awp'), handles uploading of files and redirections. It is
- multitasking by itself, and can handle any number of sites and clients simultaneously.
- It should better be used in conjunction with 'making_a_web_site.anubis' to be found in
- the same directory. If you use 'web/making_a_web_site.anubis', you don't need to read
- this file.
-
-
- ----------------------------------- Table of Contents ---------------------------------
-
- *** (1) Multihosting and redirections.
- *** (2) The incompatibility between SSL and virtual hosts.
- *** (3) HTTP headers and web arguments.
- *** (4) Site descriptions.
- *** (5) Protection against denial of service attacks.
- *** (6) Starting your HTTP and HTTPS servers.
- *** (7) Private download.
- *** (8) About web argument names.
- *** (9) A web dispatcher.
-
- ---------------------------------------------------------------------------------------
-
-
-
-
- *** (1) Multihosting and redirections.
-
- This HTTP/HTTPS server can handle several host (also called 'virtual hosts'), in other
- words, you may have several sites on the same server, with the same IP address and same
- port numbers, but distinct 'host names'.
-
- A HTTP request sent by a browser contains the following informations:
-
- - a 'host name',
- - an URI (Uniform Resource Identifier),
- - HTTP headers,
- - web arguments (in the form 'name=value').
-
- Actually, the host name is just the value of the HTTP header whose name is 'Host'. The
- host name indicates which site is requested. Hence, it is the primary information for
- branching to the right site. If there is no 'Host' HTTP header in the request, the
- request is denied.
-
- From now on, we may assume that the host is determined, and consequently that we are
- concerned by only one site. Each site has his own directories on the server's
- disk.
-
- Each site also has a list of 'redirections'. A redirection is a triplet, like this one:
-
- redirect("/", "www.our-business.com", "/homepage.awp")
-
- meaning that if the host is "www.our-business.com", and if the requested URI is "/",
- then the URI to be served is "/homepage.awp". 'redirect' is a constructor of the type
- 'Redirection' defined in 'web/common.anubis'.
-
- Now, an URI may end by ".awp" (meaning 'Anubis Web Page') or not. If it does, the
- server understands that an HTML page must be constructed on the fly, and to that end it
- calls the 'awp handler' of the site. Otherwise, the URI must end by a known extension,
- like ".jpg", ".png", ".txt", etc... and represents a file path relative to the
- 'public' directory of the site. If these conditions are satisfied, the file is sent to
- the client. Known extensions are recorded in 'web/mime.anubis'.
-
-
-
-
- *** (2) The incompatibility between SSL and virtual hosts.
-
- Handling virtual hosts makes a problem under SSL (i.e. when using HTTPS), which is due
- to the fact that the guys at Netscape who designed SSL probably did not have the
- question of virtual hosts in mind. Indeed, the SSL handshake is completed before the
- server can know about the value of the 'Host' HTTP header, so that it cannot know which
- server certificate must be sent to the client. This makes a problem, because the
- browser will not accept a certificate whose common name does not correspond to the name
- of the requested host. The user will have to accept the certificate manually, which is
- not good for the security image of the site. This problem has at least two solutions
- (as far as Anubis is concerned).
-
- Solution 1. Arrange so that the network interface on which the server is listening
- has at least as many different IP addresses as you have virtual hosts. Such
- supplementary IP addresses are called 'IP Aliases'. In this case, start one HTTPS
- server for each virtual host, each one listening on a different address. For the time
- being, this method is applicable under Anubis only if you start as many instances of
- 'anbexec' as you have virtual hosts, because each instance of 'anbexec' can handle only
- one server certificate. Of course, getting IP aliases is another problem to be solved
- with your Internet provider.
-
- Solution 2. We propose a simple solution, using only one server certificate (hence
- only one instance of 'anbexec'). Since, we have only one server certificate, we must
- introduce a notion of 'main host', i.e. a host containing all other 'virtual
- hosts'. The unique server certificate belong to the main host, so that only the main
- host is identified by the client. The client must trust the main host and be confident
- that the main host redirects him to the right virtual host. Actually, the process will
- be transparent to the client, except that the client will see the name of the main host
- instead of the name of the virtual host in the 'location' field of the browser.
-
- So, assume that the name of main host is 'www.securedhost.com', and that the names of
- the virtual hosts are:
-
- actual name simplified name
- -----------------------------------------------------
- www.virtual1.com virtual1
- www.virtual2.com virtual2
- www.virtual3.com virtual3
-
- Then the (confidential) document '/doc/my_document.pdf' on 'www.virtual2.com' will have
- the URL:
-
- https://www.securedhost.com/virtual2/doc/my_document.pdf
-
- In order to work transparently, this solution must combine HTTP and HTTPS. Indeed, the
- vitual host must have a first page reachable under HTTP, through the URL:
-
- http://www.virtual2.com/
-
- The HTTP server will redirect this URL to the awp handler of virtual host 'virtual2'.
- The handler of this virtual host is able to generate a first page containing the
- following HTML meta:
-
- ,
-
- so that the client is immediately redirected to the main host under HTTPS (hence
- accepting tranparently the server certificate). The awp handler of 'virtual2' then
- redirects this URL to the home page (maybe a login page) of 'virtual2'.
-
- See 'web/making_a_web_site.anubis' for the sequel of this story.
-
-
-
-
-
- *** (3) HTTP headers and web arguments.
-
- Each HTTP request which arrives on the server contains a request line followed by a
- series of HTTP headers. Each HTTP header is a pair '(name,value)' assigning a value to
- a name. The type 'HTTP_header' is defined in 'web/common.anubis'.
-
- The request may also have a 'body'. The body contains either 'web arguments' or
- uploaded files (or both). The request line itself may also contain web arguments (in a
- so-called 'query string'). Like HTTP headers, 'web arguments' are pairs
- '(name,value)', but the difference is that these pairs are generated by the page within
- which the client clicks, while HTTP headers are generated by the browser itself. The
- type 'Web_arg' is defined in 'web/common.anubis'. It has two alternatives, one for
- ordinary web arguments (pairs) and one for uploaded files.
-
-read CXM_common.anubis
-read tools/basis.anubis
-read CXM_mime.anubis
-
-
-
- *** (4) Site descriptions.
-
- The type HTTP_Info gathers informations comming along with the client's request. These
- informations are rarely used for composing HTML pages. Nevertheless, they are at your
- disposal.
-
-public type HTTP_Info:
- http_info
- (
- Int32 ip_address, // IP address of the client
- String uri, // URI requested by the client
- List(HTTP_header) http_headers, // HTTP headers sent by the client
- One -> String generate_trust_ticket // may be used against denial of
- // service attacks
- ).
-
-
-
- Each site is described by a 'web site description', which is a datum of type
- 'Web_Site_Description'.
-
-public type Web_Site_Description:
- web_site_description(
- List(String) common_names,
- String site_directory,
- List(Redirection) redirections,
- String charset,
- List(String) journal_extensions,
- List(String) journal_headers,
- String authorization_secret,
- List(MIME) known_mime_types,
- (String host_name,
- HTTP_Info http_info,
- List(Web_arg) lwa,
- Bool is_https) -> (List(HTTP_header),
- Printable_tree) awp_handler,
- (List(Web_arg) lwa) -> One before_send_file).
-
- The component 'common_names' is the list of names of the site, like for example
- "www.our-business.com". The reason why we have a list of common names instead of a
- single common name, is that it may be useful to have a common name like "192.168.0.1"
- for testing.
-
- 'charset' is a string which will determine the character encoding to be used by the
- browser. Typically, this string is one of: "UTF-8", "ISO-8859-1", "Windows-1252",
- etc...
-
- 'journal_extensions' is the list of URI extensions for which you want a log in the
- journal (and on the console). When a request arrives, and if the extension is a member
- of this list, a message is printed into the journal of the site including the date, the
- IP address of the client, the complete HTTP request line. The HTTP headers whose name
- is a member of 'journal_headers' are also printed in the journal. A reasonable minimum
- for these two components is:
-
- [".awp"] for journal_extensions
- ["user-agent"] for journal_headers
-
- 'authorization_secret' is a string which should just be unguessable. You may choose
- something like (but don't choose this one !):
-
- "Hg8kJe42gCML9jNH-74"
-
- i.e. a sequence of characters typed at random, long enough to be unguessable. This is
- used by the 'private download' mecanism, which is discussed later in this file.
-
- The component 'awp_handler' is a function of type:
-
- (String host_name,
- HTTP_Info http_info,
- List(Web_arg) web_args,
- Bool is_https) -> Printable_tree
-
- ('Printable_tree' is a substitute for 'String' and is defined in
- 'tools/basis.anubis'). This function is the 'awp handler' for the site. When the URI
- ends by ".awp", this function is called, and the result (an HTML page) is sent to the
- client over the connection. The last operand to this function is a boolean which is
- 'true' when the requests arrives through the HTTPS channel, and 'false' when it arrives
- through the HTTP channel.
-
-
-
-
-
-
-
- *** (5) Protection against denial of service attacks.
-
- We need to protect our servers against 'denial of service' attacks. The attack may be
- send automatically from machines which are infested by viruses. In that case, our
- server is saturated of connections (all virtual machines at work), but nothing is
- comming on the connections. In order to avoid this problem, we propose the following:
-
- (1) Limit the number of simultaneous connections (say to 100).
- (2) Close a connection if the request is not complete after say 10 seconds.
- (3) Close the connection if the request is bigger than a given size (normal requests
- are small except when there are uploaded files.
- (4) Close the connection during the sending of the answer if the client is waiting
- too much.
- (5) Record all IP addresses with which we have encountered one of the problems above.
- (6) Immediately close the connections if the IP address is in our list.
- (7) Remove an address from the list only after 5 minutes of inactivity of this
- address.
- (8) Maintain a list of reliable IP addresses.
-
- Of course, all the above are approximative solutions which may in some circumstances
- become either cumbersome or also partially block the system. So, it is needed to have a
- set of dynamically modifiable parameters in order to master the behavior of this
- mecanism.
-
-
- Each dubious IP address is recorded together with its last activity time.
-
-public type DubiousIP:
- dubious_ip (Int32 address,
- Int32 last_activity).
-
-
-public type DenialOfService:
- denial_of_service(Var(Int32) max_connections,
- Var(Int32) request_line_delay, // seconds
- Var(Int32) headers_delay,
- Var(Int32) answer_delay,
- Var(List(DubiousIP)) list_of_dubious,
- Var(List(Int32)) reliable_addresses).
-
- The informations in this set of variables are stored serialized into the file
- 'my_anubis/web_sites/dos_info'. If this file does not exist a set if variables with
- default values is created. The values are saved on the disk each time they are
- modified.
-
-public define DenialOfService load_denial_of_service_info.
-
-
-
- *** (6) Starting your HTTP and HTTPS servers.
-
- When your web site descriptions are ready, you can start a pair of servers (a HTTP
- server and a HTTPS server) for serving your web sites. Notice that there are always
- two servers, regardless of the number of web sites, and that each web sites normally
- uses the two servers.
-
-
-public define StartServerResult
- start_http_server
- (
- Int32 ip_address,
- Int32 http_port,
- List(Web_Site_Description) web_sites,
- DenialOfService dos
- ).
-
-public define StartServerResult
- start_https_server
- (
- Int32 ip_address,
- Int32 https_port,
- String certificate_common_name,
- List(Web_Site_Description) web_sites,
- DenialOfService dos
- ).
-
- The first argument 'ip_address' is the IP address on which the servers listen. If you
- put 0, the servers listen on all adresses of the machine (which is useful if the
- machine has several network interfaces). Otherwise, use the function 'ip_address'
- defined in 'tools/basis.anubis' for composing a particular IP address.
-
- The next arguments are the port numbers for HTTP and HTTPS. The usual values are 80 and
- 443, but you may have reasons to choose other values.
-
- The next argument is the list of your web site descriptions. All the sites described in
- this list will be accessible on the server.
-
- The argument 'dos' is a set of dynamic variables containing the informations for
- protecting the servers against denial of service attacks.
-
-
-
-
-
-
- *** (7) Private download.
-
- It may happen that you want to propose private files for download. This means that such
- a file could be downloaded only by the authorized person, and should not be seen by any
- other one. This feature can be used only under HTTPS, not under HTTP.
-
- The file may be located anywhere on the server. Hence, the file has a complete absolute
- path, like for example:
-
- /home/georges/my_documents/my_text.pdf
-
- which has nothing to do with the directories of the web server. Now, you may also want
- to show another path or simply just a name to the client, not the actual absolute path
- above, which may need to remain secret. So for example, the same file may appear to the
- client as:
-
- informations.pdf
-
- The page must provide a link with an authorization. The authorization is just a web
- argument, whose name is "zauth". The value of this web argument is computed by hashing
- some secret string (known only from the programmer of the web site) with the absolute
- path of the file. The HTTPS request will have the form:
-
- GET /informations.pdf?zauth=d38161f5b4e87e2d46e06ff8b3e233be563794d1
-
- The server will search for a file named
-
- zd38161f5b4e87e2d46e06ff8b3e233be563794d1
-
- (i.e. "z" concatenated with the value of the authorization) in the subdirectory
- 'private_download' of the site directory. This file contains the absolute path of the
- file, i.e:
-
- /home/georges/my_documents/my_text.pdf
-
- At that point, the server may hash the secret string and the absolute path together, to
- check if the client is authorized to download the file. If it is the case, it sends the
- file (the MIME type is declared as 'application/octet-stream' if it is not recognized).
- The file is sent under the visible name.
-
- The server creates automatically the subdirectory 'private_download/' within the 'site
- directory' (for each web site) if it does not already exist. Files in this directory
- are deleted when they become too old (for example, after 3 days of life).
-
- Here is the function for computing the value of the authorization, and for making the
- authorization file in 'private_download'.
-
-public define String
- make_authorization
- (
- String site_directory,
- String authorization_secret, // known only by the programmer of the web site
- String absolute_path // on server
- ).
-
- See 'web/making_a_web_site.anubis' for the construction of the link for downloading.
-
-
-
-
-
-
-
-
- *** (8) About web argument names.
-
- The server reserves the name "zauth" for the authorization in the private download
- mecanism. Also, if the name of a web arguments begins by "p" (like 'password'), it does
- not print the value of the web argument neither on the console or in the journal. A
- good politics is to prefix all web arguments by letters distinct from 'p' and 'z'. This
- method is used in 'web/making_a_web_site.anubis'. This will avoid clashes of names.
-
-
-
-
-
-
- *** (9) A web dispatcher.
-
- For hosting several sites you may prefer another method which we now describe. We start
- a HTTP server on port 80 (or on another port). This server is called the
- ``dispatcher''. When a requests arrives, the dispatcher examines the ``host'' HTTP
- header, so that it gets the name of the requested host. Then it sends to the client a
- page like this one:
-
-
-
-
-
-
-
-
-
- where the URL represented by '...' is the URL of the requested site. This URL may have
- the same IP address as the dispatcher, except that the port number is different. It may
- also have a different IP address.
-
- The dispatcher uses the file 'my_anubis/web_sites/dispatcher.info'. This file contains
- a serialized datum of type 'List(DispatcherInfo)'.
-
-public type DispatcherInfo:
- site(String common_name,
- Int32 http_port).
-
- The dispatcher does not write into this file. It reads it when it starts, and rereads
- it each time the date of last modification of the file changes, so that the dispatcher
- always has up to date data. The file may be managed (written and updated) by another
- program.
-
- So, for each site, the dispatcher knows the common name (needed to recognize the 'host'
- HTTP header), and the pair (ip_address,port) used by the actual site for HTTP. The
- dispatcher does not worry about HTTPS. HTTPS must be managed by the actual site.
-
- The dispatcher is started by:
-
-public define One
- start_web_dispatcher
- (
- Int32 ip_address, // address for listening (typically 0)
- Int32 port, // typically 80
- DenialOfService dos
- ).
-
- A command line tool for managing the file 'my_anubis/web_sites/dispatcher.info' is also
- provided:
-
- global define One
- manage_web_dispatcher
- (
- List(String) args
- ).
-
-
-
-
-
-
-
- --- That's all for the public part ! --------------------------------------------------
-
-
-
-
-
-
-
- ----------------------------------- Table of Contents ---------------------------------
-
- *** [1] Types which are private to this file.
-
- *** [2] Tools.
- *** [2.1] Formating an error message.
- *** [2.2] Converting IP addresses.
- *** [2.3] Reading and unputting characters.
- *** [2.4] Reading and discarding characters.
- *** [2.5] Reading a character string.
- *** [2.6] Padding integers with zeros.
- *** [2.7] Converting web arguments to ASCII.
- *** [2.8] Server description.
-
- *** [3] Managing the journal.
- *** [3.1] Naming journal files.
- *** [3.2] Formating HTTP headers.
- *** [3.3] Formating web arguments.
- *** [3.4] Formating the whole request.
- *** [3.5] Putting it in the journal file (and on the console).
-
- *** [4] Reading the HTTP request.
- *** [4.1] Skipping leading blanks.
- *** [4.2] Reading a new line.
- *** [4.3] Reading a 'word'.
- *** [4.4] Separating the URI from the query string.
- *** [4.5] Reading the web arguments.
- *** [4.7] Reading the request line.
- *** [4.8] Reading the HTTP headers.
- *** [4.9] Getting the size of the request's body.
- *** [4.10] Reading the body of the request.
-
- *** [5] Making the HTTP answer.
- *** [5.1] Avoiding illegal URIs.
- *** [5.2] Managing authorizations for downloading private files.
- *** [5.3] Recognizing MIME types.
- *** [5.4] Formating HTTP headers.
- *** [5.5] Sending a file.
- *** [5.6] Answering a www-url encoded request.
- *** [5.7] Answering a multipart/form-data encoded request.
- *** [5.7.1] Finding the boundary.
- *** [5.7.2] Reading attributes from a multipart entity.
- *** [5.7.3] Creating a temporary filename for an uploaded file.
- *** [5.7.4] Saving an uploaded file under a temporary filename.
- *** [5.7.5] Removing the path from a file name.
- *** [5.7.6] Reading a multipart entity.
- *** [5.8] Handling redirections.
- *** [5.9] Answering both sorts of requests.
-
- *** [6] The HTTP/HTTPS servers.
- *** [6.1] The HTTP request handler.
- *** [6.2] Server's tasks.
- *** [6.3] Starting the HTTP/HTTPS servers.
-
- *** [7] The web dispatcher.
- *** [7.1] The dispatcher server.
- *** [7.2] The dispatcher web site.
- *** [7.3] Managing the info file.
-
- ---------------------------------------------------------------------------------------
-
-
-
-
-read tools/basis.anubis
-read tools/findstring.anubis
-read tools/connections.anubis
-
-
-
-
-
- *** [1] Types which are private to this file.
-
- We use the following self-explanatory types.
-
-type Error:
- cannot_read_from_connection,
- not_get_or_post_request(String),
- end_of_line_expected,
- incorrect_content_length_value,
- colon_expected,
- timeout(Int32).
-
-type HTTP_RequestType:
- get,
- post.
-
-type HTTP_RequestLine:
- request_line (HTTP_RequestType type,
- String uri,
- List(Web_arg) query_string).
-
-type EncodingType:
- www_url,
- multipart_form_data.
-
-
-
-
-
- *** [2] Tools.
-
- *** [2.1] Formating an error message.
-
- The next function formats an error message.
-
-define String
- format
- (
- Error msg
- ) =
- if msg is
- {
- cannot_read_from_connection then
- "Cannot read from connection.\n",
- not_get_or_post_request(s) then
- "The request did not begin by 'GET' or 'POST': "+s+".\n",
- end_of_line_expected then
- "End of line expected.\n",
- incorrect_content_length_value then
- "Incorrect value for HTTP header 'Content-Length'.\n",
- colon_expected then
- "':' was expected.\n",
- timeout(n) then
- //"time out: "+n+"\n"
- //"time out.\n"
- ""
- }.
-
-
-
-
-
-
- *** [2.2] Converting IP addresses.
-
- We need two conversion functions for IP addresses:
-
- (Word8,Word8,Word8,Word8) --> Int32 ip_address
- Int32 --> String ip_addr_to_string
-
- These conversions are defined in 'tools/basis.anubis'.
-
-
-
-
-
-
-
-
- *** [2.3] Reading and unputting characters.
-
- We need a mecanism for unputting several characters (actually at least 3). This is
- because when reading the client connection, we must sometimes go ahead several
- characters, and virtually put them back into the connection, so that they can be
- reread. Of course, we do not send them back to the client. We store them in a list
- (hold by the variable 'unput_chars'), and we manage this list, so that characters may
- be virtually put back in the connection (this is called 'unputting').
-
-variable List(Word8) unput_chars = [].
-
- The most recently read one is the head of list. Fortunately, this variable is private
- to this virtual machine (hence to this client).
-
-
-define One
- unput // unputting a character (add it in front of the list)
- (
- Word8 character
- ) =
- unput_chars <- (List(Word8))[character . *unput_chars].
-
-
-
-define One record_dubious_IP(Int32 addr,DenialOfService dos).
-
-variable Int32 sttm = 0. // contains the start time for this connection.
-
-define Result(Error,Word8)
- record_dubious_connection
- (
- Connection conn,
- Int32 dead_line,
- DenialOfService dos,
- ) =
- if remote_IP_address_and_port(conn) is (addr,port) then
- record_dubious_IP(addr,dos);
- print("Recording IP address "+ip_addr_to_string(addr)+
- " as dubious after "+(dead_line-*sttm)+" seconds. Total: "+
- length(*list_of_dubious(dos))+"\n");
- error(timeout(dead_line)).
-
-
-define Result(Error,Word8)
- read_one_byte
- (
- Connection connection,
- Int32 dead_line,
- DenialOfService dos
- ) =
- //if now > dead_line then record_dubious_connection(connection,dead_line,dos) else
- if read(connection,1,600) is // the connection is closed after 10 minutes of inactivity
- {
- error then error(cannot_read_from_connection),
- timeout then error(timeout(600)),
- //record_dubious_connection(connection,dead_line,dos),
- ok(ba) then if nth(0,ba) is
- {
- failure then error(cannot_read_from_connection),
- success(c) then ok(c)
- }
- }.
-
-
-define Result(Error,Word8)
- next_char // reading a character (check the list first, and read on the connection
- // only when the list is empty).
- (
- Connection connection,
- Int32 dead_line,
- DenialOfService dos
- ) =
- if *unput_chars is
- {
- [ ] then read_one_byte(connection,dead_line,dos),
-
- [h . t] then
- unput_chars <- t;
- ok(h)
- }.
-
-
-
-
-
-
-
- *** [2.4] Reading and discarding characters.
-
- The next function reads the specified number of bytes (this is the same as
- 'characters') from the connection and discards them. This is used for discarding CR LF
- just before the body of a request.
-
-define Result(Error,One)
- read_and_ignore
- (
- Connection connection, // to client
- Int32 dead_line,
- Int32 number_of_characters, // number of characters to read and ignore
- DenialOfService dos
- ) =
- if number_of_characters =< 0 then ok(unique) else
- if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(c) then read_and_ignore(connection,dead_line,number_of_characters-1,dos)
- }.
-
-
-
-
-
-
-
- *** [2.5] Reading a character string.
-
- Sometimes values of HTTP attributes or web args are presented in the form of double
- quoted strings. The next function handles the reading of such things. The leading
- double quote is already read in. We must read subsequent characters until the next non
- backslashed double quote.
-
-define Result(Error,String)
- read_string
- (
- Connection connection, // connection with the client
- Int32 dead_line,
- List(Word8) so_far, // characters read so far (in reverse order)
- DenialOfService dos
- ) =
- if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(c) then
- if c = '\\'
- then if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(d) then
- if d = '\"'
- then read_string(connection,dead_line,['\"' . so_far],dos)
- else read_string(connection,dead_line,[d, c . so_far],dos)
- }
- else if c = '\"'
- then ok(implode(reverse(so_far)))
- else read_string(connection,dead_line,[c . so_far],dos)
- }.
-
-
-
-
-
-
-
- *** [2.6] Padding integers with zeros.
-
- 'zero_pad_2' transforms an integer (which is assumed to be between 0 and 99) into a
- string with exactly two digits. This is used for formating days, hours, minutes and
- seconds.
-
-define String
- zero_pad_2
- (
- Int32 n
- ) =
- with s = integer_to_string(n),
- if length(s) < 2
- then "0"+s
- else s.
-
-
-
-
-
-
-
- *** [2.7] Converting web arguments to ASCII.
-
- The function 'web_to_ascii' gets a character string and replaces web encoding by normal
- ASCII encoding. This amounts to replacing:
-
- + by blank
- %xx by the character whose ASCII code is xx in hexadecimal
-
- Note: We assume that '9' < 'A' (which is the case for ASCII code).
-
-
-
-define Word8
- web_decode
- (
- Word8 x1,
- Word8 x2
- ) =
- with z1 = word8_to_int32(x1),
- n1 = if z1 =< '9' then (z1 - '0') else (z1 - 'A' + 10),
- z2 = word8_to_int32(x2),
- n2 = if z2 =< '9' then (z2 - '0') else (z2 - 'A' + 10),
- n = (n1 << 4) + n2,
- truncate_to_word8(n).
-
-
-
-define String
- web_to_ascii
- (
- String web_string,
- Int32 n, // current position in web_string
- List(Word8) so_far
- ) =
- if nth(n,web_string) is
- {
- failure then implode(reverse(so_far)),
- success(c) then
- if c = '+'
- then web_to_ascii(web_string,n+1,[' ' . so_far])
- else if c = '%'
- then if nth(n+1,web_string) is
- {
- failure then implode(reverse(so_far)),
- success(x1) then if nth(n+2,web_string) is
- {
- failure then implode(reverse(so_far)),
- success(x2) then web_to_ascii(web_string,n+3,[web_decode(x1,x2) . so_far])
- }
- }
- else web_to_ascii(web_string,n+1,[c . so_far])
- }.
-
-
-
-
-
-
-
-
- *** [3] Managing the journal.
-
- Concurrently working machines should not try to access the same file at the same
- time. This problem may be solved by using the 'protect' mecanism.
-
-
-
- *** [3.1] Naming journal files.
-
- Since journal messages are rather prolific, we should have at least one file per
- hour. Hence, the name of a journal file must be constructed from the current year,
- month, day and hour. For example, it may be:
-
- 2003_03_12_19
-
- (this is for the journal of 7 PM to 8 PM, 2003/mar/12).
-
-define String
- make_current_journal_file_name
- =
- if convert_time(now) is date_and_time(y,m,d,h,_,_,_,_,_) then
- integer_to_string(y)+"_"+
- zero_pad_2(m)+"_"+
- zero_pad_2(d)+"_"+
- zero_pad_2(h).
-
-
-
-
-
-
-
- *** [3.2] Formating HTTP headers.
-
- HTTP headers may be shown on the console or written in the journal. The function below
- formats a list of HTTP headers.
-
-define String
- show_format
- (
- Web_Site_Description desc,
- List(HTTP_header) headers,
- ) =
- if headers is
- {
- [ ] then "",
- [h . t] then if h is http_header(name,value) then
- if member(journal_headers(desc),name)
- then " | "+name+": "+value+"\n"+show_format(desc,t)
- else show_format(desc,t)
- }.
-
-
-
-
-
-
- *** [3.3] Formating web arguments.
-
- The same thing for web arguments.
-
-define String
- show_format
- (
- List(Web_arg) lwa
- ) =
- if lwa is
- {
- [ ] then "",
- [h . t] then if h is
- {
- web_arg(n,v) then
- " | "+n+"="+(if nth(0,n) = success('p') then "" else v)+"\n"+show_format(t),
- upload(n,fn,tfn) then
- " | "+n+"="+fn+" (uploaded as '"+tfn+"')\n"+show_format(t)
- }
- }.
-
-
-
-
-
-
- *** [3.4] Formating the whole request.
-
- It is cheap to transform month numbers into abbreviated month names. This enhances the
- readability of the journal.
-
-define String
- format_month
- (
- Int32 m
- ) =
- if m = 1 then "jan" else
- if m = 2 then "feb" else
- if m = 3 then "mar" else
- if m = 4 then "apr" else
- if m = 5 then "may" else
- if m = 6 then "jun" else
- if m = 7 then "jul" else
- if m = 8 then "aug" else
- if m = 9 then "sep" else
- if m = 10 then "oct" else
- if m = 11 then "nov" else
- if m = 12 then "dec" else
- "???".
-
-
- Below we format a whole HTTP request. This may give this (actually, it depends on how
- you defined the values of 'journal_headers' and 'journal_extensions'):
-
- [3] 2003/mar/10 10:06:57 from 123.456.123.456: /homepage.awp
- | host: www.the-best-one.com
- | user-agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0
-
- The leading number between brackets is the number of the virtual machine which served
- the URI.
-
-define String
- format_request
- (
- Web_Site_Description desc,
- Connection client_connection,
- HTTP_RequestLine request_line,
- List(HTTP_header) headers,
- List(Web_arg) web_args
- ) =
- with dt = convert_time(now),
- if remote_IP_address_and_port(client_connection) is (addr,port) then
- integer_to_string(year(dt))+"/"+format_month(month(dt))+"/"+zero_pad_2(day(dt))+" "+
- zero_pad_2(hour(dt))+":"+zero_pad_2(minute(dt))+":"+zero_pad_2(second(dt))+
- " from "+ip_addr_to_string(addr)+
- ": "+uri(request_line)+"\n"+
- show_format(desc,headers)+
- show_format(web_args).
-
-
-
-
-
-
-
- *** [3.5] Putting it in the journal file (and on the console).
-
- We must not forget to 'protect' this operation, so that the messages of two machines
- (working for the same site) will not be mixed together.
-
-define One
- log_journal_msg
- (
- Web_Site_Description desc,
- String msg,
- ) =
- with msg = to_byte_array("["+virtual_machine_id+"] "+msg+"\n"),
- protect
- (
- if file(site_directory(desc)+"/journal/"+make_current_journal_file_name,append) is
- {
- failure then unique,
- success(journal_file) then
- forget(reliable_write(file(journal_file),msg))
- };
- forget(reliable_write(file(stdout),msg))
- ).
-
-
-
-
-
-
-
- *** [4] Reading the HTTP request.
-
-
- *** [4.1] Skipping leading blanks.
-
- One of the peculiarities of HTTP is that the characters 13 (carriage return) and 10
- (line feed) followed by either a space (32) or a tab (9), is considered as a blank not
- containing any new line. 'skip_http_blanks' must skip all blanks characters until the
- first non blank character, which should not be read in. Obviously, because of the above
- peculiarity, we need at least 3 characters of lookahead to do this. In other words, we
- must be able to unput at least 3 characters (hopefully we are).
-
- Strictly blanks characters are 'space' and 'tab'.
-
-define Bool
- is_strict_blank
- (
- Word8 c
- ) =
- if c = ' ' then true else c = '\t'.
-
-
- On the contrary, blanks include 13 and 10.
-
-define Bool
- is_blank
- (
- Word8 c
- ) =
- if c = ' ' then true else
- if c = '\t' then true else
- if c = 13 then true else
- c = 10.
-
-
- Skipping HTTP blanks.
-
-define Result(Error,One)
- skip_http_blanks
- (
- Connection connection,
- Int32 dead_line,
- DenialOfService dos
- ) =
- if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(c) then
- if is_strict_blank(c)
- then skip_http_blanks(connection,dead_line,dos)
- else if c = 13
- then if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg), // (unput(c); ok(unique)),
- ok(d) then
- if d = 10
- then if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg), // (unput(d); unput(c); ok(unique)),
- ok(e) then
- if is_strict_blank(e)
- then skip_http_blanks(connection,dead_line,dos)
- else (unput(e); unput(d); unput(c); ok(unique))
- }
- else (unput(d); unput(c); ok(unique))
- }
- else (unput(c); ok(unique))
- }.
-
-
-
-
-
-
-
-
- *** [4.2] Reading a new line.
-
- Normally in HTTP a new line is the sequence 13 10 (carriage return line feed), not
- followed by a space or tabulator. If it is followed by a space or tabulator, the three
- characters are considered blanks, and no new line has been read. Before trying to read
- a new line, we first skip leading spaces and tabs. Then we try to read 13 and 10, and
- we read another character. if this character is space or tab, we consider we have read
- only blanks and we continue reading in order to find our new line. Otherwise, we unput
- this character (which may be for example the first character of the name of the next
- header), and answer that we have seen a new line.
-
- Warning: we must not use this function for reading the last pair (13,10) before the
- beginning of the body, because if the body is empty, there is no character to read
- after this pair, so that the server could wait for a character which will never
- come. This is the reason for 'read_and_ignore' above, which is used precisely for
- reading that last (13,10) pair.
-
-define Result(Error,One)
- read_new_line
- (
- Connection connection,
- Int32 dead_line,
- DenialOfService dos
- ) =
- if skip_http_blanks(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(_) then
- if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(c) then
- if c = 13
- then if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(d) then
- if d = 10
- then ok(unique)
- else (unput(d);
- unput(c);
- error(end_of_line_expected))
- }
- else (unput(c);
- error(end_of_line_expected))
- }}.
-
-
-
-
-
-
-
-
- *** [4.3] Reading a 'word'.
-
- A 'word' is a sequence of characters which begins either by a double quote or not by a
- double quote. (However, any leading blanks are read in and ignored. This is
- accomplished by 'skip_http_blanks'.) If it begins by a double quote, it is read like a
- string, i.e. it ends at the next (non backslashed) double quote. Otherwise, it is
- right delimited by any character which may be considered as 'blank'. If the word is
- double quoted, the closing double quote is read in. On the contrary, if the word is not
- double quoted, the right delimiting blank character is not read in (it is 'unput' back
- into the connection), and may be read in again. This is needed because carriage return
- or line feed which are 'blank', also have a meaning in HTTP.
-
-define Result(Error,String)
- read_word_aux
- (
- Connection connection,
- Int32 dead_line,
- List(Word8) so_far,
- DenialOfService dos
- ) =
- if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(c) then
- if is_blank(c)
- then (unput(c);
- ok(implode(reverse(so_far))))
- else read_word_aux(connection,dead_line,[c . so_far],dos)
- }.
-
-define Result(Error,String)
- read_word
- (
- Connection connection,
- Int32 dead_line,
- DenialOfService dos
- ) =
- if skip_http_blanks(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(_) then
- if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(c) then
- if c = '\"'
- then read_string(connection,dead_line,[],dos)
- else read_word_aux(connection,dead_line,[c],dos)
- }
- }.
-
-
-
-
-
-
-
-
- *** [4.4] Separating the URI from the query string.
-
- A 'query string' may be postfixed to the URI, just after a question mark. For example,
- the client may send the following request:
-
- GET /catalog.awp?item=3&color=blue
-
- We separate this into an URI: "/catalog.awp" and the string: "item=3&color=blue" which
- will be later transformed into the list:
-
- [web_arg("item","3"),web_arg("color","blue")]
-
-
-define (String,String)
- separate_uri_from_query_string
- (
- String uri_and_query_string,
- Int32 n
- ) =
- if nth(n,uri_and_query_string) is
- {
- failure then (uri_and_query_string,""),
- success(c) then
- if c = '?'
- then (substr(uri_and_query_string,0,n),
- substr(uri_and_query_string,n+1,length(uri_and_query_string)-(n+1)))
- else separate_uri_from_query_string(uri_and_query_string,n+1)
- }.
-
-
-
-
-
-
-
-
-
- *** [4.5] Reading the web arguments.
-
- HTTP/HTTPS requests are sent in one of two formats:
-
- (1) www-url encoded
- (2) multipart/form-data encoded
-
- The first one is the normal (historical) way of encoding. The second one is required
- for uploading files. A server which is supposed to accept upload of files must handle
- both formats. The first thing to do is to decide the format of the request. This is
- easily done by examining the HTTP headers. If we find the header:
-
- Content-Type: multipart/form-data
-
- the request is multipart/form-data encoded. Otherwise, it is 'www-url' encoded. We
- first consider 'www-url' encoded requests.
-
- For a 'www-url' encoded request, the web argument are either in the query string or in
- the body of the request, or both. The format is the same for both:
-
- name=value&name=value&...
-
- However, we may also have
-
- name
- name=
- name=&...
- name&...
-
- i.e. some parts may be missing. Hence, we must be careful.
-
- Furthermore, web arguments must be translated from web to ASCII when www-url encoded.
-
-define Bool
- is_ampersand_or_equal
- (
- Word8 c
- ) =
- if c = '&' then true else c = '='.
-
-
-
- The function 'read_name_or_value' reads the string 's' starting at position 'n' until
- either the end of the string or the first '&' or '='.
-
-define String
- read_name_or_value
- (
- String s,
- Int32 start,
- Int32 i
- ) =
- if nth(i,s) is
- {
- failure then substr(s,start,i - start),
- success(c) then
- if is_ampersand_or_equal(c)
- then substr(s,start,i-start) // the separator is not included
- else read_name_or_value(s,start,i+1)
- }.
-
-
-define List(Web_arg)
- read_www_url_encoded_web_args
- (
- String s,
- Int32 start,
- ) =
- with first = read_name_or_value(s,start,start),
- if first = ""
- then []
- else with i = start+length(first),
- if nth(i,s) is
- {
- failure then [web_arg(first,"")],
- success(c) then
- if c = '&'
- then [web_arg(first,"") . read_www_url_encoded_web_args(s,i+1)]
- else if c = '='
- then with second1 = read_name_or_value(s,i+1,i+1),
- // print("\""+second1+"\"\n");
- with second = web_to_ascii(second1,0,[]),
- [web_arg(first,second) . read_www_url_encoded_web_args(s,i+length(second1)+2)]
- else alert
- }.
-
-
-
-
-
- *** [4.7] Reading the request line.
-
- 'read_request_line' reads three words and a new line from the connection. It tries to
- recognize "GET" or "POST" in the first word, separates the URI from the query string in
- the second word, transforms the query string into a list of 'Web_arg', and finally
- returns a datum of type 'HTTP_RequestLine' if no error arose.
-
-
-define Result(Error,HTTP_RequestType)
- identify_get_or_post
- (
- String s
- ) =
- with s = to_lower(s),
- if s = "get" then ok(get) else
- if s = "post" then ok(post) else
- error(not_get_or_post_request(s)).
-
-define Result(Error,HTTP_RequestLine)
- read_request_line
- (
- Connection connection,
- Int32 dead_line,
- DenialOfService dos
- ) =
- if read_word(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(get_or_post) then if read_word(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(uri_and_query_string) then if read_word(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(http_version) then if read_new_line(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(_) then if separate_uri_from_query_string(uri_and_query_string,0) is
- (uri,query_string) then if identify_get_or_post(get_or_post) is
- {
- error(msg) then error(msg),
- ok(request_type) then
- ok(request_line(request_type,uri,read_www_url_encoded_web_args(query_string,0)))
- }
- }
- }
- }
- }.
-
-
-
-
-
-
-
- *** [4.8] Reading the HTTP headers.
-
- Each header is made of a name (containing only letters, the underscore, digits and the
- minus sign), a colon, a value, and a new line. The first empty line ends the headers.
-
-
- The next function tests characters acceptable in a header name.
-
-define Bool
- is_header_name_char
- (
- Word8 c
- ) =
- with n = word8_to_int32(c),
- if ('a' =< n & n =< 'z') then true else
- if ('A' =< n & n =< 'Z') then true else
- if ('0' =< n & n =< '9') then true else
- if c = '-' then true else
- c = '_'.
-
-define Result(Error,String)
- read_header_name
- (
- Connection connection,
- Int32 dead_line,
- List(Word8) so_far,
- DenialOfService dos
- ) =
- if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(c) then
- if is_header_name_char(c)
- then read_header_name(connection,dead_line,[to_lower(c) . so_far],dos)
- else unput(c); ok(implode(reverse(so_far)))
- }.
-
-define Result(Error,One)
- skip_colon
- (
- Connection connection,
- Int32 dead_line,
- DenialOfService dos
- ) =
- if skip_http_blanks(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(_) then
- if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(c) then
- if c = ':'
- then ok(unique)
- else error(colon_expected)
- }}.
-
-
-define Result(Error,String)
- read_header_value
- (
- Connection connection,
- Int32 dead_line,
- List(Word8) so_far,
- DenialOfService dos
- ) =
- if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(c) then
- if c = 13
- then if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(d) then
- if d = 10
- then if next_char(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(e) then
- if is_strict_blank(e)
- then read_header_value(connection,dead_line,[e . so_far],dos)
- else (unput(e); ok(implode(reverse(so_far))))
- }
- else read_header_value(connection,dead_line,[d, c . so_far],dos)
- }
- else read_header_value(connection,dead_line,[c . so_far],dos)
- }.
-
-
- Reading a single header.
-
-define Result(Error,Maybe(HTTP_header))
- read_header
- (
- Connection connection,
- Int32 dead_line,
- DenialOfService dos
- ) =
- if read_header_name(connection,dead_line,[],dos) is
- {
- error(msg) then error(msg),
- ok(name) then
- if name = "" then
- if read_and_ignore(connection,dead_line,2,dos) /* 13 and 10 */ is
- {
- error(msg) then error(msg),
- ok(_) then // this is the blank line
- ok(failure) // end of headers
- }
- else if skip_colon(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(_) then if skip_http_blanks(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(_) then if read_header_value(connection,dead_line,[],dos) is
- {
- error(msg) then error(msg),
- ok(value) then
- ok(success(http_header(name,value)))
- }
- }
- }
- }.
-
-
-
- Reading all the headers.
-
-define Result(Error,List(HTTP_header))
- read_http_headers
- (
- Connection connection,
- Int32 dead_line,
- DenialOfService dos
- ) =
- if read_header(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(mbh) then if mbh is
- {
- failure then ok([ ]),
- success(header) then
- if read_http_headers(connection,dead_line,dos) is
- {
- error(msg) then error(msg),
- ok(others) then ok([header . others])
- }
- }
- }.
-
-
-
-
-
-
-
- *** [4.9] Getting the size of the request's body.
-
- The size of the body of the request is given under the 'Content-Length' header. If this
- header is not present, the size is assumed to be zero.
-
-define Result(Error,Int32)
- get_body_size
- (
- List(HTTP_header) headers
- ) =
- if headers is
- {
- [ ] then ok(0),
- [h . t] then if h is http_header(name,value) then
- if name = "content-length"
- then if string_to_integer(value) is
- {
- failure then error(incorrect_content_length_value),
- success(n) then ok(n)
- }
- else get_body_size(t)
- }.
-
-
-
-
-
-
-
-
-
-
- *** [4.10] Reading the body of the request.
-
- The body of the request may be very big (it contains uploaded files, if any). We read
- it using the primitive 'read', which returns the number of bytes read, which may be
- less than the number of bytes we wanted to read. This is not an error, but simply due
- to the fact the buffer associated with the connection in the Linux (or MS-Windows)
- kernel has a limited size. Hence, we must read bytes again until we have read the
- required number of bytes. However, if the number of bytes read is zero, the connection
- may be broken. In that case, we must not try to read indefinitely. On the contrary, we
- make at most 10 retries, with a small sleeping time between any two of them.
-
-define Result(Error,ByteArray)
- read_http_body
- (
- Connection connection,
- Int32 body_size,
- ByteArray so_far, // when calling this function, 'so_far' is the empty byte array
- Int32 retries // this function is called with retries = 10
- ) =
- if body_size = 0 then ok(constant_byte_array(0,0)) else
- if retries =< 0 then error(cannot_read_from_connection) else
- if read(connection,body_size,60) is
- {
- error then error(cannot_read_from_connection),
- timeout then error(timeout(60)),
- ok(new_bytes) then with
- ba = so_far + new_bytes, // contains all the bytes read so far
- nr = length(ba), // total read since the beginning
- nn = length(new_bytes), // number of bytes just read
- if nr < body_size // must read more bytes
- then if nn > 0 // if connection seems to work
- then read_http_body(connection,body_size,ba,1000) // continue reading
- else sleep(100); // otherwise, sleep 1/10 of second
- read_http_body(connection,body_size,ba, // and retry reading
- retries-1) // but no more than 10 times
- else ok(ba) // required number of bytes has been read
- }.
-
-
- Note: During sleeping, 'anbexec' runs other machines. Actually, calling 'sleep', even
- for one millisecond, is some way of giving up explicitly, so that other virtual
- machines may work.
-
-
-
-
-
-
-
-
-
-
-
-
- *** [5] Making the HTTP answer.
-
- At that point we have read the request line, the headers and the body of the
- request, and we must decide what to do.
-
- Actually, we can do one of the following:
-
- - send a file,
- - execute 'tickets_and_web_page' in case of an ".awp" URI.
-
- The uploaded file (which are in the body of the request) are saved into temporary files
- below.
-
-
-
-
-
- *** [5.1] Avoiding illegal URIs.
-
- For security reasons, we must avoid illegal URIs, for example those which may climb up
- in the file hierarchy. First we accept only few characters in URIs.
-
-define Bool
- is_legal_uri_char
- (
- Word8 c
- ) =
- with n = word8_to_int32(c),
- if ('a' =< n & n =< 'z') then true else // accept 'a' to 'z'
- if ('A' =< n & n =< 'Z') then true else // accept 'A' to 'Z'
- if ('0' =< n & n =< '9') then true else // accept '0' to '9'
- if c = '.' then true else // accept '.' '-' '/' and '_'
- if c = '-' then true else
- if c = '/' then true else
- c = '_'.
-
- We do not accept ~ which is some way of climbing. Of course, we cannot disallow single
- dots, which are most often present in legal URIs, but we must avoid double dots ..
- which mean 'climb up'.
-
-define Bool
- is_illegal_uri
- (
- String uri,
- Int32 n
- ) =
- if nth(n,uri) is
- {
- failure then false,
- success(c) then
- if c = '.' // first dot
- then if nth(n+1,uri) is
- {
- failure then false,
- success(d) then
- if d = '.' // second dot
- then true
- else is_illegal_uri(uri,n+1)
- }
- else is_illegal_uri(uri,n+1)
- }.
-
-
-
-
-
-
- *** [5.2] Managing authorizations for downloading private files.
-
- Computing the authorization and making the authorization file (containing the absolute
- path of the file on the server).
-
-
-define String
- compute_authorization
- (
- String authorization_secret,
- String absolute_path
- ) =
- to_ascii(sha1((authorization_secret,
- absolute_path))).
-
-
-public define String
- make_authorization
- (
- String site_directory,
- String authorization_secret,
- String absolute_path
- ) =
- with private_download_dir = site_directory+"/private_download",
- auth = compute_authorization(authorization_secret,
- absolute_path),
- forget(save(absolute_path,
- private_download_dir+"/z"+auth));
- auth.
-
-
- The function 'send_file' defined below handles the recognition of authorizations.
-
-
-
-
-
- *** [5.3] Recognizing MIME types.
-
- The extension of the (redirected) URI must be either ".awp" or recognized as associated
- to a MIME type. Otherwise, the server will not send the file. This is for security, but
- also because, we must generate a 'Content-Type' header in the answer, with the right
- MIME type.
-
-define String
- get_uri_extension_aux
- (
- String uri,
- Int32 n // used for searching backwards
- ) =
- if nth(n,uri) is
- {
- failure then "",
- success(c) then
- if c = '.' then substr(uri,n,length(uri)-n)
- else if c = '/' then ""
- else get_uri_extension_aux(uri,n-1)
- }.
-
-public define String
- get_uri_extension
- (
- String uri
- ) =
- get_uri_extension_aux(uri,
- length(uri)-1). // search starts at the right end
-
-
-
-define Maybe(String)
- recognize_mime_type_from_ext
- (
- String ext,
- List(MIME) l
- ) =
- if l is
- {
- [ ] then success("application/octet-stream"), // failure,
- [h . t] then if h is mime(mime_type,extension) then
- if ext = extension
- then success(mime_type)
- else recognize_mime_type_from_ext(ext,t)
- }.
-
-define Maybe(String)
- recognize_mime_type_from_uri
- (
- Web_Site_Description desc,
- String uri
- ) =
- recognize_mime_type_from_ext(get_uri_extension(uri),known_mime_types(desc)).
-
-
-
-
-
-
-
-
- *** [5.4] Formating HTTP headers.
-
- This is the formating for sending to the client (hence, it has nothing to do with the
- component 'journal_headers' in the web site description).
-
-define Printable_tree
- format_headers
- (
- List(HTTP_header) headers
- ) =
- if headers is
- {
- [ ] then [ ],
- [h . t] then if h is http_header(name,value) then
- [name,": ",value,crlf . format_headers(t)]
- }.
-
-
-
-
-
-
- *** [5.5] Sending a file.
-
- We send 2 headers 'Content-Type' and 'Content-Length'.
-
-define List(HTTP_header)
- headers_for_send_file
- (
- String mime_type,
- Int32 size,
- ) =
- [
- http_header("Content-Type",mime_type),
- http_header("Content-Length",integer_to_string(size)),
- ].
-
-
-
- Sending the body of the answer (i.e. the file itself).
-
-define One
- send_file_body
- (
- Web_Site_Description desc,
- Connection connection, // connection with the client
- Connection file, // file to be sent already opened
- Int32 size, // size of file
- Int32 sent, // bytes already sent
- String filename // name of file
- ) =
- if sent >= size then unique else
- if read(file,min(10000,size-sent),60) is
- {
- error then log_journal_msg(desc,"Cannot read from file '"+filename+"'.\n"),
- timeout then log_journal_msg(desc,"Cannot read from file timeoput'"+filename+"'.\n"),
- ok(ba) then
- with nr = length(ba), // get the number of bytes read
- if reliable_write(connection,ba) is
- {
- failure then log_journal_msg(desc,"Cannot write into connection.\n"),
- success(nw) then
- send_file_body(desc,connection,file,size,sent+nw,filename)
- }
- }.
-
-
-
-
- Sending the answer line, the headers and the body.
-
-define One
- send_file
- (
- Web_Site_Description desc,
- Connection connection,
- List(HTTP_header) headers,
- Int32 size,
- Connection file,
- String filename,
- One -> One action_before_send_file
- ) =
- action_before_send_file(unique);
- forget(reliable_write(connection,to_byte_array("HTTP/1.1 200 OK"+crlf)));
- forget(reliable_write(connection,[format_headers(headers) , crlf]));
- send_file_body(desc,connection,file,size,0,filename).
-
-
-
- Checking if a connection is under SSL.
-
-define Bool
- is_SSL
- (
- Connection c
- ) =
- if c is
- {
- file_r(_) then false,
- file_w(_) then false,
- file_rw(_) then false,
- tcp(_) then false,
- ssl(_) then true
- }.
-
-
-
- Before opening and sending a file, we check the MIME type. It must be recognized,
- except if there is a valid authorization for private download.
-
-define One
- send_file
- (
- Web_Site_Description desc,
- Connection connection,
- String uri,
- Maybe(String) mbauthorization,
- One -> One action_before_send_file
- ) =
- if mbauthorization is
- {
- //--- file without authorization: take it from public ---
- failure then if recognize_mime_type_from_uri(desc,uri) is
- {
- failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"),
- success(mime_type) then
- with path = site_directory(desc)+"/public"+uri,
- if (Maybe(RStream))connect to file path is
- {
- failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"),
- success(f) then with size = file_size(f),
- send_file(desc,
- connection,
- headers_for_send_file(mime_type,size),
- size,
- file(f),
- uri,
- action_before_send_file)
- }
- },
-
- //--- file with authorization: apply 'private download' mecanism ---
- success(authorization) then
- with private_download_dir = site_directory(desc)+"/private_download",
- if (RetrieveResult(String))retrieve(private_download_dir+"/z"+authorization)
- is ok(absolute_path)
- then (
- with new_hash = compute_authorization(authorization_secret(desc),
- absolute_path),
- if (Maybe(RStream))connect to file absolute_path is
- {
- failure then log_journal_msg(desc,"Cannot find file '"+absolute_path+"'.\n"),
- success(f) then with size = file_size(f),
- send_file(desc,
- connection,
- headers_for_send_file(if recognize_mime_type_from_uri(desc,uri) is
- {
- failure then "application/octet-stream"
- success(mime_type) then mime_type
- },
- size),
- size,
- file(f),
- uri,
- action_before_send_file)
- }
- )
- else log_journal_msg(desc,"Cannot find or read authorization file.\n")
- }.
-
-
- define One
- send_file
- (
- Web_Site_Description desc,
- Connection connection,
- String uri,
- Maybe(String) mbauthorization,
- One -> One action_before_send_file
- ) =
- if mbauthorization is
- {
- //--- file without authorization: take it from public ---
- failure then if recognize_mime_type_from_uri(desc,uri) is
- {
- failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"),
- success(mime_type) then
- with path = site_directory(desc)+"/public"+uri,
- if (Maybe(RStream))connect to file path is
- {
- failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"),
- success(f) then with size = file_size(f),
- send_file(desc,
- connection,
- headers_for_send_file(mime_type,size),
- size,
- file(f),
- uri,
- action_before_send_file)
- }
- },
-
- //--- file with authorization: apply 'private download' mecanism ---
- success(authorization) then
- if is_SSL(connection)
- then (
- with private_download_dir = site_directory(desc)+"/private_download",
- if (RetrieveResult(String))retrieve(private_download_dir+"/z"+authorization)
- is ok(absolute_path)
- then (
- with new_hash = compute_authorization(authorization_secret(desc),
- absolute_path),
- if (Maybe(RStream))connect to file absolute_path is
- {
- failure then log_journal_msg(desc,"Cannot find file '"+absolute_path+"'.\n"),
- success(f) then with size = file_size(f),
- send_file(desc,
- connection,
- headers_for_send_file(if recognize_mime_type_from_uri(desc,uri) is
- {
- failure then "application/octet-stream"
- success(mime_type) then mime_type
- },
- size),
- size,
- file(f),
- uri,
- action_before_send_file)
- }
- )
- else log_journal_msg(desc,"Cannot find or read authorization file.\n")
- )
- else //-- file with authorization, but under HTTP: take it from private_download
- if recognize_mime_type_from_uri(desc,uri) is
- {
- failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"),
- success(mime_type) then
- with path = site_directory(desc)+"/private_download"+uri,
- if (Maybe(RStream))connect to file path is
- {
- failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"),
- success(f) then with size = file_size(f),
- send_file(desc,
- connection,
- headers_for_send_file(mime_type,size),
- size,
- file(f),
- uri,
- action_before_send_file)
- }
- }
- }.
-
-
-
-
-
-
-
- *** [5.6] Answering a www-url encoded request.
-
- Standard headers are for answering ".awp" requests.
-
-define List(HTTP_header)
- standard_headers
- (
- Int32 answer_body_size,
- String charset
- ) =
- [
- //http_header("Content-Type","text/html"),
- http_header("Content-Type","text/html; charset="+charset),
- http_header("Content-length",integer_to_string(answer_body_size))
- ].
-
-
-define One
- www_url_answer
- (
- String host_name,
- Web_Site_Description desc,
- Connection connection, // with the client
- Int32 ip_addr, // of the client
- HTTP_RequestLine request_line,
- List(HTTP_header) headers,
- ByteArray body,
- One -> String generate_tt // trust ticket generation
- ) =
- with all_web_args = query_string(request_line) +
- read_www_url_encoded_web_args(to_string(body),0),
- uri = uri(request_line),
- ext = get_uri_extension(uri),
- (if member(journal_extensions(desc),ext)
- then log_journal_msg(desc,
- format_request(desc,connection,request_line,headers,all_web_args))
- else unique);
- if is_illegal_uri(uri,0)
- then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
- else (if (ext = ".awp" | ext = "")
- then (with answer_headers_body = awp_handler(desc)(host_name,
- http_info(ip_addr,uri,headers,generate_tt),
- all_web_args,
- is_SSL(connection)),
- if answer_headers_body is (additional_headers,answer_body) then
- forget(reliable_write(connection,
- [ "HTTP/1.1 200 OK", crlf,
- format_headers(standard_headers(length(answer_body),charset(desc))),
- format_headers(additional_headers),
- crlf .
- answer_body])))
- else (send_file(desc,
- connection,
- uri,
- if web_arg_value(all_web_args,"zauth") is
- {
- not_found then failure,
- found(v) then success(v)
- },
- (One u) |-> before_send_file(desc)(all_web_args)))).
-
-
-
-
-
-
-
- *** [5.7] Answering a multipart/form-data encoded request.
-
- In order to support upload of files, we must be able to read web arguments which are
- encoded in a multipart/form-data body. The first thing to do is to find the
- boundary. The boundary is a special string which delimits the various parts of the
- 'multipart' body. It is found within the value of the 'Content-Type' HTTP header, as
- the value of the 'boundary' attribute.
-
-
-
-
-
- *** [5.7.1] Finding the boundary.
-
- Hence, we just have to find the string 'boundary=' within the value of the
- 'Content-Type' header, and read the value of the boundary from there.
-
-define Bool
- delimits_boundary
- (
- Word8 c
- ) =
- if c = ' ' then true else
- if c = 13 then true else
- if c = 10 then true else
- if c = 0 then true else
- if c = ',' then true else
- c = ';'.
-
-
-define Maybe(String)
- get_boundary_value_3
- (
- String s,
- Int32 i,
- List(Word8) so_far
- ) =
- if nth(i,s) is
- {
- failure then success(implode(reverse(so_far))),
- success(c) then
- if delimits_boundary(c)
- then success(implode(reverse(so_far)))
- else get_boundary_value_3(s,i+1,[c . so_far])
- }.
-
-
-
-define Maybe(String)
- get_boundary_value_2
- (
- String s,
- Int32 i,
- ) =
- if nth(i,s) is
- {
- failure then failure,
- success(c) then
- if is_blank(c)
- then get_boundary_value_2(s,i+1)
- else get_boundary_value_3(s,i+1,[c])
- }.
-
-define Maybe(String)
- get_boundary_value_1
- (
- String s, // string into which we must find '= ...'
- Int32 i // position of start of search
- ) =
- if nth(i,s) is
- {
- failure then failure,
- success(c) then
- if is_blank(c)
- then get_boundary_value_1(s,i+1)
- else if c = '='
- then get_boundary_value_2(s,i+1)
- else failure
- }.
-
-
-define Maybe(String)
- get_boundary
- (
- String content_type_header_value
- ) =
- if find("boundary",content_type_header_value,0) is
- {
- failure then failure,
- success(n) then // 'boundary' has been found at position n
- get_boundary_value_1(content_type_header_value,n+8)
- }.
-
-define Maybe(String)
- get_boundary
- (
- List(HTTP_header) headers
- ) =
- if headers is
- {
- [ ] then failure,
- [h . t] then if h is http_header(name,value) then
- if name = "content-type"
- then get_boundary(value)
- else get_boundary(t)
- }.
-
-
-
-
-
-
-
-
- *** [5.7.2] Reading attributes from a multipart entity.
-
- Entities in a multipart/form-data body are separated by instances of the string:
-
- --bbbbb
-
- where bbbbb is the boundary computed above. Actually, the body has the form:
-
- --bbbbb
-
- --bbbbb
-
- --bbbbb
- ...
- --bbbbb
-
- --bbbbb
-
-
- We have to extract an entity which is in the body between offsets 'start' and 'end'
- (computed when boundaries have been localized). The entity itself is made of two parts:
- headers and body. The body is separated from the headers by a blank line. This blank
- line (a double crlf) marks the beginning of the body of the entity. Within the headers
- of the entity, we look for a 'Content-Disposition' header, which should look like this:
-
- Content-Disposition: form-data; name="..."; filename="..." crlf
-
- We are just interested in the name and the file name. Hence we first search
- 'Content-Disposition', then we search 'name' and read the value, and we do the same for
- 'filename'.
-
- If the 'filename' attribute is not present, the web arg is an ordinary one, otherwise,
- it is an uploaded file.
-
-
- Below is a variant of 'find' (see 'tools/findstring.anubis'), with an extra 'end'
- argument.
-
-define Maybe(Int32)
- find
- (
- String what,
- ByteArray where,
- Int32 start,
- Int32 end
- ) =
- if find(to_byte_array(what),where,start) is
- {
- failure then failure,
- success(n) then
- if n+length(what) >= end
- then failure
- else success(n)
- }.
-
-
-define String
- read_attribute_value
- (
- ByteArray where,
- Int32 start,
- Int32 end,
- List(Word8) so_far
- ) =
- if start >= end then implode(reverse(so_far)) else
- if nth(start,where) is
- {
- failure then implode(reverse(so_far)),
- success(c) then
- if c = '\"'
- then implode(reverse(so_far))
- else read_attribute_value(where,start+1,end,[c . so_far])
- }.
-
-define Maybe(String)
- find_attribute
- (
- String name,
- ByteArray where,
- Int32 start,
- Int32 end
- ) =
- with name = name+"=\"",
- if find(to_byte_array(name),where,start) is
- {
- failure then failure,
- success(n) then
- if n+length(name) >= end
- then failure
- else success(read_attribute_value(where,n+length(name),end,[]))
- }.
-
-
-
-define Maybe((String,Maybe(String)))
- find_name_and_filename
- (
- ByteArray body,
- Int32 start,
- Int32 end
- ) =
- if find(to_byte_array("Content-Disposition"),body,start) is
- {
- failure then failure,
- success(n) then
- if find_attribute("name",body,n+19,end) is
- {
- failure then failure,
- success(name_value) then if find_attribute("filename",body,n+19,end) is
- {
- failure then success((name_value,failure)),
- success(filename_value) then success((name_value,success(filename_value)))
- }
- }
- }.
-
-
-
-
-
-
-
-
-
-
- *** [5.7.3] Creating a temporary filename for an uploaded file.
-
-variable Int32 uploaded_file_count = 0.
-
- This variable is local to the virtual machine. Hence, its value is 0 each time a new
- requests arrives. Temporary uploaded files are stored in the directory represented by
- 'upload_temporary_directory'. The filenames have the form:
-
- _m_n
-
- where 'm' is the number of the virtual machine, and 'n' a number obtained by
- incrementing 'uploaded_file_count'. Notice that the program must do something with this
- file (move it to some directory/name), otherwise, it will probably be overwritten the
- next time the same machine works.
-
-
-
-
-
-
- *** [5.7.4] Saving an uploaded file under a temporary filename.
-
-define Maybe(String) // returns the temporary file name
- save_uploaded_file
- (
- Web_Site_Description desc,
- ByteArray body,
- Int32 start,
- Int32 end
- ) =
- uploaded_file_count <- 1 + *uploaded_file_count;
- with tfn = "_"+integer_to_string(virtual_machine_id)+"_"+integer_to_string(*uploaded_file_count),
- if (Maybe(WStream))connect to file site_directory(desc)+"/upload_temporary/"+tfn is
- {
- failure then failure,
- success(f) then
- if reliable_write(file(f),extract(body,start,end)) is
- {
- failure then failure,
- success(nw) then
- if nw = end - start
- then success(tfn)
- else failure
- }
- }.
-
-
-
-
-
-
-
-
- *** [5.7.5] Removing the path from a file name.
-
- When a file is uploaded, the browser sends the complete path of the file on the client
- machine as the file name. Actually, this is not quite normal. Nevertheless, we need to
- remove the path, and keep only the file name. This is achieved by 'remove_path' below.
-
-define Int32
- file_name_begin
- (
- String full_name,
- Int32 i
- ) =
- if nth(i,full_name) is
- {
- failure then 0,
- success(c) then
- if c = '/' then i+1 else
- if c = '\\' then i+1 else
- file_name_begin(full_name,i-1)
- }.
-
-define String
- remove_path
- (
- String full_name
- ) =
- with l = length(full_name),
- b = file_name_begin(full_name,l-1),
- substr(full_name,b,l-b).
-
-
-
-
-
- *** [5.7.6] Reading a multipart entity.
-
-define Maybe(Web_arg)
- get_multipart_entity
- (
- Web_Site_Description desc,
- ByteArray body,
- Int32 start,
- Int32 end
- ) =
- if find(to_byte_array(crlf+crlf),body,start) is
- {
- failure then failure,
- success(k) then
- if k >= end // must be within this entity, not the next one
- then failure
- else if find_name_and_filename(body,start,k) is
- {
- failure then failure,
- success(n_mbfn) then if n_mbfn is (name,mbfn) then
- if mbfn is
- {
- failure then
- success(web_arg(name,to_string(extract(body,k+4,end-2)))),
- // we must substract 2 to end because of crlf just before the boundary
-
- success(fn) then
- if save_uploaded_file(desc,body,k+4,end-2) is
- {
- failure then failure,
- success(tfn) then
- success(upload(name,remove_path(fn),
- site_directory(desc)+"/upload_temporary/"+tfn))
-
- }
- }
- }
- }.
-
-
-
-define List(Web_arg)
- read_multipart_form_data_encoded_web_args
- (
- Web_Site_Description desc,
- ByteArray body,
- ByteArray __boundary,
- Int32 i,
- ) =
- if find(__boundary,body,i) is
- {
- failure then [ ],
- success(n) then
- if find(__boundary,body,n+length(__boundary)) is
- {
- failure then [ ],
- success(m) then
- if get_multipart_entity(desc,body,n+length(__boundary),m) is
- {
- failure then [ ],
- success(wa) then
- [wa . read_multipart_form_data_encoded_web_args(desc,body,__boundary,m)]
- }
- }
- }.
-
-
-
-define One
- multipart_form_data_answer
- (
- String host_name,
- Web_Site_Description desc,
- Connection connection,
- Int32 ip_addr,
- HTTP_RequestLine request_line,
- List(HTTP_header) headers,
- ByteArray body,
- One -> String generate_tt
- ) =
- if get_boundary(headers) is
- {
- failure then unique,
- success(boundary) then
- with all_web_args = query_string(request_line) +
- read_multipart_form_data_encoded_web_args(desc,
- body,
- to_byte_array("--"+boundary),
- 0),
- uri = uri(request_line),
- ext = get_uri_extension(uri),
- log_journal_msg(desc,
- format_request(desc,connection,request_line,headers,all_web_args));
- if is_illegal_uri(uri,0)
- then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
- else
- if (ext = ".awp" | ext = "") then
- (with answer_headers_body = awp_handler(desc)(host_name,
- http_info(ip_addr,uri,headers,generate_tt),
- all_web_args,
- is_SSL(connection)),
- if answer_headers_body is (additional_headers,answer_body) then
- forget(reliable_write(connection,
- [ "HTTP/1.1 200 OK",crlf,
- format_headers(standard_headers(length(answer_body),charset(desc))),
- format_headers(additional_headers),
- crlf .
- answer_body])))
- else unique
- }.
-
-
-
-
-
-
-
-
- *** [5.8] Handling redirections.
-
- 'redirections' (of type 'List(Redirection)') contains redirection directives. Each one
- has the form:
-
- redirect(required_uri,required_host,corresponding_uri).
-
- The host required by the client may be found in the 'Host' HTTP header. The URI
- required by the client is given below as 'uri'. We just have to find the required host
- in the headers, and to find the corresponding redirection directive.
-
-
- In the next fonction, the required host and URI are known. We just have to search in
- the 'redirections' list.
-
-define String
- handle_redirection
- (
- String required_uri,
- String required_host,
- List(Redirection) redirections
- ) =
- if redirections is
- {
- [ ] then required_uri,
- [h . t] then if h is redirect(uri,host,target) then
- if host = required_host
- then if uri = required_uri
- then target
- else handle_redirection(required_uri,required_host,t)
- else handle_redirection(required_uri,required_host,t)
- }.
-
-
-
- The host name may be encumbered by a port number, like
-
- www.our-business.com:1607
-
- We must remove this port number, otherwise the host name may not be recognized.
-
-define String
- strip_port
- (
- String name,
- Int32 i
- ) =
- if nth(i,name) is
- {
- failure then name,
- success(c) then
- if c = ':'
- then substr(name,0,i)
- else strip_port(name,i+1)
- }.
-
-
-
-
-
- Finding the 'Host' header. No redirection is performed if this header is not found.
-
-define String
- handle_redirection // returns the redirected URI
- (
- List(Redirection) redirections,
- String uri, // original URI
- List(HTTP_header) headers
- ) =
- if headers is
- {
- [ ] then uri,
- [h . t] then if h is http_header(name,value) then
- if name = "host"
- then handle_redirection(uri,strip_port(value,0),redirections)
- else handle_redirection(redirections,uri,t)
- }.
-
-
-
-
-
-
-
-
- *** [5.9] Answering both sorts of requests.
-
- We must decide if the request is www-url encoded or multipart/form-data encoded. This
- is achieved through the header 'Content-Type'.
-
-define EncodingType
- get_encoding_type
- (
- List(HTTP_header) headers
- ) =
- if headers is
- {
- [ ] then www_url, // this is the default
- [h . t] then if h is http_header(name,value) then
- if name = "content-type"
- then if find("multipart/form-data",value,0) is
- {
- failure then www_url,
- success(_) then multipart_form_data
- }
- else get_encoding_type(t)
- }.
-
-
-
-define One
- send_answer
- (
- String host_name,
- Web_Site_Description desc,
- Connection connection,
- HTTP_RequestLine rqline,
- List(HTTP_header) headers,
- ByteArray body,
- One -> String generate_tt
- ) =
- if rqline is request_line(type,uri,qstring) then
- with rqline = request_line(type,handle_redirection(redirections(desc),uri,headers),qstring),
- if remote_IP_address_and_port(connection) is (ip_addr,_) then
- if get_encoding_type(headers) is
- {
- www_url then
- www_url_answer(host_name,desc,connection,ip_addr,rqline,headers,body,generate_tt),
- multipart_form_data then
- multipart_form_data_answer(host_name,desc,connection,ip_addr,rqline,headers,body,generate_tt)
- }.
-
-
-
-
-
-
-
- *** [6] The HTTP/HTTPS server.
-
- The command 'start_server' (declared in 'predefined.anubis') starts a virtual machine
- which opens a server TCP/IP connection, and which continuously listens to this
- connection. When a request arrives, this machine delegates the work of deciphering and
- answering the request to another virtual machine, and continues to listen. The job of
- the delegated machine is defined by the HTTP request handler below.
-
-
-
-
-
- *** [6.1] Determining the requested host.
-
- When a request arrives to one of our two servers, we must decide which site (host) is
- requested.
-
-define Maybe(String)
- get_host_header_value
- (
- List(HTTP_header) headers
- ) =
- if headers is
- {
- [ ] then failure,
- [h . t] then if h is http_header(name,value) then
- if name = "host"
- then success(strip_port(value,0))
- else get_host_header_value(t)
- }.
-
-define Maybe((String,Web_Site_Description))
- get_site
- (
- String requested_host,
- List(Web_Site_Description) sites
- ) =
- if sites is
- {
- [ ] then print("Requested host '"+requested_host+"' does not exist.\n"); failure,
- [site1 . others] then
- if site1 is web_site_description(common_names,_,_,_,_,_,_,_,_,_) then
- if member(common_names,requested_host)
- then success((requested_host,site1))
- else get_site(requested_host,others)
- }.
-
-
-define Maybe((String,Web_Site_Description))
- get_site
- (
- List(HTTP_header) headers,
- List(Web_Site_Description) sites
- ) =
- if get_host_header_value(headers) is
- {
- failure then print("No 'Host' HTTP header.\n"); failure,
- success(requested_host) then
- //here we treat the case with only one site. hence we accept any host request
- //print("*** there is " +length(sites) + " sites \n");
- if length(sites) = 1 then
- with site = force_nth(0, sites),
- //print("ONE server OK\n");
- success((requested_host, site))
- else
- get_site(requested_host,sites)
- }.
-
-
-
-
-
- *** [6.2] The HTTP request handler.
-
- Here is the HTTP/HTTPS handler. It is called at each new request in a separate virtual
- machine. It reads the headers of the HTTP request, determines the host, determines body
- size, reads the body of the HTTP request, and answers the request.
-
-
-
-define One -> String make_generate_trust_ticket(DenialOfService dos).
-
-
-define One
- http_https_handler
- (
- List(Web_Site_Description) sites,
- Connection connection,
- Bool is_https,
- DenialOfService dos
- ) =
- with start_time = (Int32)now,
- sttm <- start_time;
- if dos is denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
- if remote_IP_address_and_port(connection) is (ip_addr,port) then
- if read_request_line(connection,start_time+*rld_v,dos) is
- {
- error(msg) then print(format(msg)),
- ok(request_line) then
- if read_http_headers(connection,start_time+*hd_v,dos) is
- {
- error(msg) then print(format(msg)),
- ok(headers) then if get_site(headers,sites) is
- {
- failure then unique,
- success(p) then if p is (host_name,desc) then
- if get_body_size(headers) is
- {
- error(msg) then log_journal_msg(desc,format(msg)),
- ok(body_size) then
- if read_http_body(connection,body_size,constant_byte_array(0,0),1000) is
- {
- error(msg) then log_journal_msg(desc,format(msg)),
- ok(body) then
- send_answer(host_name,desc,connection,request_line,headers,body,
- make_generate_trust_ticket(dos))
- }
- }
- }
- }
- }.
-
-
- Below are the two tools for constructing the handlers required by 'start_server' and
- 'start_ssl_server' (see 'predefined.anubis').
-
-define Bool is_dubious_IP(Int32 ip, DenialOfService dos).
-
-define Server -> ((RWStream) -> One)
- make_http_handler
- (
- List(Web_Site_Description) sites,
- DenialOfService dos
- ) =
- (Server server) |-> (RWStream connection) |->
- if remote_IP_address_and_port(connection) is (addr,_) then
- if is_dubious_IP(addr,dos)
- then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
- else http_https_handler(sites,tcp(connection),false,dos).
-
-define Server -> (SSL_Connection -> One)
- make_https_handler
- (
- List(Web_Site_Description) sites,
- DenialOfService dos
- ) =
- (Server server) |-> (SSL_Connection connection) |->
- http_https_handler(sites,ssl(connection),true,dos).
-
-
-
-
- *** [6.3] Server's tasks.
-
- Some tasks must be executed periodically, for example for cleaning up directories from
- short life time files.
-
- The next function removes from the given directory (and recursively from its
- subdirectories) all the files which are more than 10 minutes old.
-
-define One
- cleanup_directory_10mn
- (
- String dir // path of private download directory (or subdirectory) with trailing slash
- ) =
- forget(map((FileDescription fd) |-> if fd is
- {
- no_info(name) then forget(remove(dir+name)),
- file(name,_,_,d) then if d+600 < now then forget(remove(dir+name)) else unique,
- link(name,_,_,d) then if d+600 < now then forget(remove(dir+name)) else unique,
- directory(name,_,_) then cleanup_directory_10mn(dir+name+"/"),
- },
- directory_full_list(dir,"*","*","*"))).
-
-
-define One
- http_servers_tasks
- (
- List(Web_Site_Description) sites,
- List(Server) servers,
- Int32 period,
- Int32 next_time,
- ) =
- if mapand(is_down,servers)
- then unique
- else if now > next_time
- then
- (
- /*
- forget(map((Web_Site_Description wsd) |->
- cleanup_directory_10mn(site_directory(wsd)+"/private_download/"),
- sites));
- */
- http_servers_tasks(sites,servers,period,next_time+period)
- )
- else
- (
- sleep(1000);
- http_servers_tasks(sites,servers,period,next_time)
- ).
-
-
-public define One
- start_http_servers_tasks
- (
- List(Web_Site_Description) sites,
- List(Server) servers,
- Int32 period
- ) =
- delegate http_servers_tasks(sites,servers,period,now),
- unique.
-
-
-
-
- *** [6.4] Protection against 'denial of service' attacks.
-
-
- *** [6.4.1] Counting connections.
-
-define Bool // returns false if the counter cannot be incremented (too many connections)
- increment_connections_counter
- (
- Var(Int32) counter
- ) =
- protect with n = *counter,
- if n >= 100
- then false
- else (counter <- (*counter)+1); true.
-
-define One
- decrement_connections_counter
- (
- Var(Int32) counter
- ) =
- protect counter <- (*counter)-1.
-
-
-
-
-
- *** [6.4.2] Recording dubious IP addresses.
-
-
-define List(DubiousIP)
- record_dubious_IP
- (
- Int32 ip,
- List(DubiousIP) l
- ) =
- if l is
- {
- [ ] then [dubious_ip(ip,now)],
- [h . t] then if h is dubious_ip(addr,time) then
- if addr = ip
- then [dubious_ip(addr,now) . t]
- else [h . record_dubious_IP(ip,t)]
- }.
-
-
-define One
- record_dubious_IP
- (
- Int32 dubious_IP,
- Var(List(DubiousIP)) v
- ) =
- protect v <- record_dubious_IP(dubious_IP,*v).
-
-
-define One
- record_dubious_IP
- (
- Int32 addr,
- DenialOfService dos
- ) =
- record_dubious_IP(addr,list_of_dubious(dos)).
-
-
-public define DenialOfService
- load_denial_of_service_info
- =
- if (RetrieveResult(DenialOfService))retrieve(my_anubis_directory+"/web_sites/dos_info") is
- ok(dos) then dos else denial_of_service(
- var(100),
- var(1000),
- var(1500),
- var(2000),
- var([]),
- var([])).
-
-
-
-
- *** [6.4.3] Testing if an address is dubious.
-
-define Bool
- is_dubious_IP
- (
- Int32 ip,
- List(DubiousIP) l
- ) =
- if l is
- {
- [ ] then false,
- [h . t] then if h is dubious_ip(addr,time) then
- if ip = addr
- then true
- else is_dubious_IP(ip,t)
- }.
-
-
-define Bool
- is_dubious_IP
- (
- Int32 ip,
- DenialOfService dos
- ) =
- if dos is
- {
- denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
- if member(*ra_v,ip) then false else
- is_dubious_IP(ip,*ld_v)
- }.
-
-
-
-
- *** [6.4.4] Removing inactive dubious IP addresses.
-
-define List(DubiousIP)
- remove_inactive_dubious_IP
- (
- List(DubiousIP) l,
- Int32 ref_time,
- ) =
- if l is
- {
- [ ] then [ ],
- [h . t] then if h is dubious_ip(addr,time) then
- if time < ref_time
- then (print(ip_addr_to_string(addr)+" removed from dubious addresses list.\n");
- remove_inactive_dubious_IP(t,ref_time))
- else [h . remove_inactive_dubious_IP(t,ref_time)]
- }.
-
-define One
- remove_inactive_dubious_IP
- (
- Var(List(DubiousIP)) v
- ) =
- protect
- with ref_time = now - 600, // 10 minutes
- v <- remove_inactive_dubious_IP(*v,ref_time).
-
-
- The above function will be executed periodically by the servers's tasks machine.
-
-
-
- *** [6.4.5] Making the function for generating trust tickets.
-
-define One -> String
- make_generate_trust_ticket
- (
- DenialOfService dos
- ) =
- (One _) |-> "".
-
-
-
-
-
-
-
- *** [6.5] Starting the HTTP/HTTPS server.
-
-
- The next function creates the directories for all sites (if they don't already exist).
-
-define One
- create_directories
- (
- List(Web_Site_Description) sites
- ) =
- if sites is
- {
- [ ] then unique,
- [s1 . others] then
- with site_dir = site_directory(s1),
- forget(make_directory(site_dir+"/public",default_directory_mode));
- forget(make_directory(site_dir+"/upload_temporary",default_directory_mode));
- forget(make_directory(site_dir+"/private_download",default_directory_mode));
- forget(make_directory(site_dir+"/journal",default_directory_mode));
- create_directories(others)
- }.
-
-
-
-
-
- Below are the commands for starting an HTTP server and an HTTPS server.
-
-
-define StartServerResult
- start_http_server
- (
- Int32 ip_address,
- Int32 port,
- Server -> ((RWStream) -> One) handler,
- Int32 retries,
- DenialOfService dos
- ) =
- if start_server(ip_address,
- port,
- handler,
- identity) is ok(server)
- then print(" \r");
- ok(server)
- else print("Port "+port+": retry number "+retries+"\r");
- sleep(1000);
- start_http_server(ip_address,port,handler,retries+1,dos).
-
-public define StartServerResult
- start_http_server
- (
- Int32 ip_address,
- Int32 port,
- List(Web_Site_Description) sites,
- DenialOfService dos
- ) =
- create_directories(sites);
- start_http_server(ip_address,port,
- make_http_handler(sites,dos),
- 0,
- dos).
-
-
- For the HTTPS server, we have a problem which is due to the fact that 'anbexec' is not
- yet able to manipulate several SSL server certificates. 'anbexec' and
- 'predefined.anubis' must be changed. Sorry ! This will be done as soon as possible. The
- 'solution' for the time being is to provide the common name of the unique SSL server
- certificate.
-
-
-define StartServerResult
- start_https_server
- (
- Int32 ip_address,
- Int32 port,
- String certificate_common_name,
- Server -> (SSL_Connection -> One) handler,
- Int32 retries,
- DenialOfService dos
- ) =
- if start_ssl_server(ip_address,
- port,
- certificate_common_name,
- handler,
- identity) is ok(server)
- then print(" \r");
- ok(server)
- else print("Port "+port+": retry number "+retries+"\r");
- sleep(1000);
- start_https_server(ip_address,port,
- certificate_common_name,
- handler,retries+1,
- dos).
-
-
-public define StartServerResult
- start_https_server
- (
- Int32 ip_address,
- Int32 port,
- String certificate_common_name, // of SSL server certificate
- List(Web_Site_Description) sites,
- DenialOfService dos
- ) =
- create_directories(sites);
- start_https_server(ip_address,port,certificate_common_name,
- make_https_handler(sites,dos),
- 0,dos).
-
-
-
-
-
-
-
-
-
- *** [7] The web dispatcher.
-
-
- *** [7.1] The dispatcher server.
-
-define One
- send_dispatching_page
- (
- RWStream conn,
- String common_name,
- Int32 port
- ) =
- print("Dispatching '"+common_name+"' to port "+port+"\n");
- forget(reliable_write(conn,to_byte_array(
- ""
- ))).
-
-
-
-define Maybe(DispatcherInfo)
- find_host
- (
- List(DispatcherInfo) l,
- String host
- ) =
- if l is
- {
- [ ] then failure,
- [h . t] then if h is site(name,port) then
- if name = host
- then success(h)
- else find_host(t,host)
- }.
-
-
-
-define Server -> ((RWStream) -> One)
- make_dispatcher_handler
- (
- Var(List(DispatcherInfo)) info_v,
- DenialOfService dos
- ) =
- (Server server) |-> (RWStream conn) |->
- with start_time = (Int32)now,
- if read_request_line(tcp(conn),start_time+*request_line_delay(dos),dos) is
- {
- error(msg) then print(format(msg)),
- ok(request_line) then
- if read_http_headers(tcp(conn),start_time+*headers_delay(dos),dos) is
- {
- error(msg) then print(format(msg)),
- ok(headers) then if get_host_header_value(headers) is
- {
- failure then print("No 'HOST' HTTP header.\n"),
- success(host) then
- if find_host(*info_v,host) is
- {
- failure then print("Host: '"+host+"' not registered.\n"),
- success(s) then if s is site(common_name,ip_port) then
- send_dispatching_page(conn,common_name,ip_port)
- }
- }
- }
- }.
-
-
-define One
- dispatcher_update_error
- (
- String file_path
- ) =
- print("web_dispatcher: unable to reread file: '"+file_path+"'.\n").
-
-
-define Bool
- dispatcher_update_data
- (
- String info_file_path,
- Var(List(DispatcherInfo)) info_v,
- Var(Int32) info_date_v
- ) =
- if directory_full_list(my_anubis_directory+"/web_sites","dispatcher.info","","") is
- {
- [ ] then false,
- [h . t] then if h is
- {
- no_info(n) then false,
- file(n,_,_,d) then if n = "dispatcher.info"
- then (info_date_v <- d;
- if (RetrieveResult(List(DispatcherInfo)))retrieve(info_file_path) is
- {
- cannot_find_file then false,
- read_error then false,
- type_error then false,
- ok(info) then info_v <- info; true
- })
- else false,
- link(_,_,_,_) then false,
- directory(_,_,_) then false
- }
- }.
-
-
-
- The loop within which the dispatcher updates its data every 3 seconds:
-
-define One
- dispatcher_update_task
- (
- String info_file_path,
- Var(List(DispatcherInfo)) info_v,
- Var(Int32) info_date_v
- ) =
- sleep(3000);
- (if dispatcher_update_data(info_file_path,info_v,info_date_v)
- then unique
- else dispatcher_update_error(info_file_path));
- dispatcher_update_task(info_file_path,info_v,info_date_v).
-
-
-public define One
- start_web_dispatcher
- (
- Int32 ip_address, // address for listening (typically 0: listen on all interfaces)
- Int32 http_port, // typically 80
- DenialOfService dos
- ) =
- with info_file_path = my_anubis_directory+"/web_sites/dispatcher.info",
- info_v = var((List(DispatcherInfo))[]),
- info_date_v = var((Int32)0),
- if dispatcher_update_data(info_file_path,info_v,info_date_v)
- then if start_server(ip_address,
- http_port,
- make_dispatcher_handler(info_v,dos),
- (One u)|->u) is
- {
- cannot_create_the_socket then
- print("Cannot create the socket for HTTP server.\n"),
- cannot_bind_to_port then
- print("Cannot bind HTTP server to port "+http_port+".\n"),
- cannot_listen_on_port then
- print("HTTP server cannot listen on port "+http_port+".\n"),
- ok(http_server) then
- dispatcher_update_task(info_file_path,info_v,info_date_v)
- }
- else dispatcher_update_error(info_file_path).
-
-
-
- *** [7.2] The dispatcher web site.
-
- global define One
- web_dispatcher
- (
- List(String) args
- ) =
- start_web_dispatcher(0,80,load_denial_of_service_info).
-
-
-
-
-
-
- *** [7.3] Managing the info file.
-
-define Int32
- register_ip_address
- =
- if ip_address(prompt(" numerical IP address (for HTTP): ")) is
- {
- failure then print(" *** Error: incorrect IP address.\n");
- register_ip_address,
- success(n) then n
- }.
-
-
-define Int32
- register_ip_port
- =
- if string_to_integer(prompt(" IP port (for HTTP): ")) is
- {
- failure then print(" *** Error: incorrect IP port.\n");
- register_ip_port,
- success(p) then if (0 =< p & p =< 65535)
- then p
- else print(" *** Error: IP port out of bounds.\n");
- register_ip_port
- }.
-
-
-define One
- register_new_site
- (
- Var(List(DispatcherInfo)) info_v
- ) =
- print("\n");
- print(" Registering a new site:\n");
- with name = prompt(" Site name: "),
- with addr = register_ip_address,
- with port = register_ip_port,
- (protect info_v <- [site(name,port) . *info_v]);
- print(" Site "+name+" at "+ip_addr_to_string(addr)+":"+port+" added\n (but not saved to disk).\n").
-
-
-define List(DispatcherInfo)
- find_sites
- (
- List(DispatcherInfo) l,
- String name
- ) =
- if l is
- {
- [ ] then [ ],
- [h . t] then if h is site(n,_) then
- if find(name,n,0) is
- {
- failure then find_sites(t,name),
- success(_) then [h . find_sites(t,name)]
- }
- }.
-
-
-define String
- pad
- (
- String s,
- Int32 l
- ) =
- if length(s) >= l
- then s
- else s+constant_string(l-length(s),' ').
-
-
-
-define One
- show_sites_1
- (
- List(DispatcherInfo) l,
- Int32 i
- ) =
- if l is
- {
- [ ] then unique,
- [h . t] then if h is site(name,port) then
- print(" ["+i+"] "+pad(name,40)+" "+" "+port+"\n");
- show_sites_1(t,i+1)
- }.
-
-
-define One
- show_sites
- (
- List(DispatcherInfo) l,
- Int32 i
- ) =
- print(" Name Port\n");
- print(" --------------------------------------------------------\n");
- show_sites_1(l,i).
-
-define List(DispatcherInfo)
- replace_info
- (
- List(DispatcherInfo) l,
- String site_name,
- Int32 new_port
- ) =
- if l is
- {
- [ ] then alert,
- [h . t] then if h is site(n,_) then
- if n = site_name
- then [site(n,new_port) . t]
- else [h . replace_info(t,site_name,new_port)]
- }.
-
-define List(DispatcherInfo)
- delete_info
- (
- List(DispatcherInfo) l,
- String site_name,
- ) =
- if l is
- {
- [ ] then alert,
- [h . t] then if h is site(n,_) then
- if n = site_name
- then t
- else [h . delete_info(t,site_name)]
- }.
-
-
-define One
- update_site
- (
- Var(List(DispatcherInfo)) info_v,
- String site_name,
- Int32 old_port
- ) =
- print("\n");
- print(" Updating site '"+site_name+"': (currently: "+old_port+")\n");
- with new_port = register_ip_port,
- answer = prompt(" Update '"+site_name+"' as: "+new_port+" [Y/N] ? "),
- if (answer = "Y" | answer = "y")
- then info_v <- replace_info(*info_v,site_name,new_port)
- else unique.
-
-
-
-define Bool
- compare
- (
- DispatcherInfo d1,
- DispatcherInfo d2
- ) =
- if d1 is site(n1,_) then
- if d2 is site(n2,_) then
- string_less(n1,n2).
-
-
-
-define One
- update_site
- (
- Var(List(DispatcherInfo)) info_v
- ) =
- print("\n");
- with prefix = prompt(" Search for site to update: "),
- if find_sites(*info_v,prefix) is
- {
- [ ] then print(" No site found.\n");
- update_site(info_v),
- [h . t] then
- show_sites(qsort([h . t],compare),1);
- with i1 = prompt(" Choose a site to update [1/.../"+(length(t)+1)+"]: "),
- if string_to_integer(i1) is
- {
- failure then print(" *** Error: site number not recognized.\n");
- update_site(info_v),
- success(ii1) then if nth(ii1-1,*info_v) is
- {
- failure then print(" *** Error: site number "+i1+" does not exist.\n");
- update_site(info_v),
- success(site_info) then if site_info is site(name,old_port) then
- update_site(info_v,name,old_port)
- }
- }
- }.
-
-
-define One
- delete_site
- (
- Var(List(DispatcherInfo)) info_v,
- String site_name,
- Int32 old_port
- ) =
- print("\n");
- print(" Deleting site '"+site_name+"': (currently: "+old_port+")\n");
- with answer = prompt(" Are you sure you want to delete site: '"+site_name+"' [Y/N] ? "),
- if (answer = "Y" | answer = "y")
- then info_v <- delete_info(*info_v,site_name)
- else print(" Site '"+site_name+"' not deleted.\n").
-
-
-define One
- delete_site
- (
- Var(List(DispatcherInfo)) info_v
- ) =
- print("\n");
- with prefix = prompt(" Search for site to delete: "),
- if find_sites(*info_v,prefix) is
- {
- [ ] then print(" No site found.\n");
- delete_site(info_v),
- [h . t] then
- show_sites(qsort([h . t],compare),1);
- with i1 = prompt(" Choose a site to delete [1/.../"+(length(t)+1)+"]: "),
- if string_to_integer(i1) is
- {
- failure then print(" *** Error: site number not recognized.\n");
- delete_site(info_v),
- success(ii1) then if nth(ii1-1,*info_v) is
- {
- failure then print(" *** Error: site number "+i1+" does not exist.\n");
- delete_site(info_v),
- success(site_info) then if site_info is site(name,old_port) then
- delete_site(info_v,name,old_port)
- }
- }
- }.
-
-
-define One
- manager
- (
- Var(List(DispatcherInfo)) info_v,
- String file_path
- ) =
- print("\n");
- print(" --- Welcome to the Web Dispatcher Manager ---\n");
- with l = length(*info_v),
- print(" "+l+" site"+(if l>1 then "s" else "")+" currently registred.\n");
- print(" [L] List registered sites.\n");
- print(" [R] Register a new site.\n");
- print(" [U] Update a registred site.\n");
- print(" [D] Delete a registred site.\n");
- with propose_write_v = var((Bool)true),
- action = prompt(" Choose an action [L/R/U/D]: "),
- (if (action = "L" | action = "l") then (show_sites(*info_v,1); propose_write_v <- false) else
- if (action = "R" | action = "r") then register_new_site(info_v) else
- if (action = "U" | action = "u") then update_site(info_v) else
- if (action = "D" | action = "d") then delete_site(info_v) else
- print("Action not recognized.\n"));
- print("\n");
- if *propose_write_v then
- with result = prompt(" Write modifications to data base [Y/N] ?"),
- if (result = "Y" | result = "y")
- then if save(*info_v,file_path) is
- {
- cannot_open_file then print(" File '"+file_path+"' not found.\n"),
- write_error then print(" Error while writing file '"+file_path+"'.\n"),
- ok then print(" Data base has been modified.\n")
- }
- else print(" Data base not modified.\n")
- else unique.
-
-
-
-global define One
- manage_web_dispatcher
- (
- List(String) args
- ) =
- with info_v = var((List(DispatcherInfo))[]),
- with file_path = my_anubis_directory+"/web_sites/dispatcher.info",
- if (RetrieveResult(List(DispatcherInfo)))retrieve(file_path) is
- {
- cannot_find_file then print("File '"+file_path+"' does not exist.\n");
- with answer = prompt("Create it [Y/N] ? "),
- if (answer = "Y" | answer = "y")
- then if save((List(DispatcherInfo))[],file_path) is
- {
- cannot_open_file then
- print("Cannot create file '"+file_path+"'.\n"),
- write_error then
- print("Error while creating file '"+file_path+"'.\n"),
- ok then manager(info_v,file_path)
- }
- else unique,
- read_error then print("Error while reading file '"+file_path+"'.\n"),
- type_error then print("File '"+file_path+"' is corrupted.\n"),
- ok(info) then info_v <- info;
- manager(info_v,file_path)
- }.
-
-
-
-
-
+
+ *Project* The Anubis Project
+
+ *Title* A Multi Host HTTP/HTTPS Server
+
+ *Copyright* Copyright (c) Anubis Team 2003-2007.
+
+
+ *Authors* Alain Prouté
+ David René
+ Cédric Ricard
+
+
+ *Revised* July 2007.
+
+
+
+ *Overviews*
+ In this file a HTTP/HTTPS server is defined, which is able to handle multiple hosts
+ (virtual hosts). It answers HTTP/HTTPS requests, sends files (images or any other kind
+ of file), constructs HTML pages on the fly using informations received from the client
+ (when the URI ends by '.awp'), handles uploading of files and redirections. It is
+ multitasking by itself, and can handle any number of sites and clients simultaneously.
+ It should better be used in conjunction with 'making_a_web_site.anubis' to be found in
+ the same directory. If you use 'web/making_a_web_site.anubis', you don't need to read
+ this file.
+
+
+ ----------------------------------- Table of Contents ---------------------------------
+
+ *** (1) Multihosting and redirections.
+ *** (2) The incompatibility between SSL and virtual hosts.
+ *** (3) HTTP headers and web arguments.
+ *** (4) Site descriptions.
+ *** (5) Protection against denial of service attacks.
+ *** (6) Starting your HTTP and HTTPS servers.
+ *** (7) Private download.
+ *** (8) About web argument names.
+ *** (9) A web dispatcher.
+
+ ---------------------------------------------------------------------------------------
+
+
+
+
+ *** (1) Multihosting and redirections.
+
+ This HTTP/HTTPS server can handle several host (also called 'virtual hosts'), in other
+ words, you may have several sites on the same server, with the same IP address and same
+ port numbers, but distinct 'host names'.
+
+ A HTTP request sent by a browser contains the following informations:
+
+ - a 'host name',
+ - an URI (Uniform Resource Identifier),
+ - HTTP headers,
+ - web arguments (in the form 'name=value').
+
+ Actually, the host name is just the value of the HTTP header whose name is 'Host'. The
+ host name indicates which site is requested. Hence, it is the primary information for
+ branching to the right site. If there is no 'Host' HTTP header in the request, the
+ request is denied.
+
+ From now on, we may assume that the host is determined, and consequently that we are
+ concerned by only one site. Each site has his own directories on the server's
+ disk.
+
+ Each site also has a list of 'redirections'. A redirection is a triplet, like this one:
+
+ redirect("/", "www.our-business.com", "/homepage.awp")
+
+ meaning that if the host is "www.our-business.com", and if the requested URI is "/",
+ then the URI to be served is "/homepage.awp". 'redirect' is a constructor of the type
+ 'Redirection' defined in 'web/common.anubis'.
+
+ Now, an URI may end by ".awp" (meaning 'Anubis Web Page') or not. If it does, the
+ server understands that an HTML page must be constructed on the fly, and to that end it
+ calls the 'awp handler' of the site. Otherwise, the URI must end by a known extension,
+ like ".jpg", ".png", ".txt", etc... and represents a file path relative to the
+ 'public' directory of the site. If these conditions are satisfied, the file is sent to
+ the client. Known extensions are recorded in 'web/mime.anubis'.
+
+
+
+
+ *** (2) The incompatibility between SSL and virtual hosts.
+
+ Handling virtual hosts makes a problem under SSL (i.e. when using HTTPS), which is due
+ to the fact that the guys at Netscape who designed SSL probably did not have the
+ question of virtual hosts in mind. Indeed, the SSL handshake is completed before the
+ server can know about the value of the 'Host' HTTP header, so that it cannot know which
+ server certificate must be sent to the client. This makes a problem, because the
+ browser will not accept a certificate whose common name does not correspond to the name
+ of the requested host. The user will have to accept the certificate manually, which is
+ not good for the security image of the site. This problem has at least two solutions
+ (as far as Anubis is concerned).
+
+ Solution 1. Arrange so that the network interface on which the server is listening
+ has at least as many different IP addresses as you have virtual hosts. Such
+ supplementary IP addresses are called 'IP Aliases'. In this case, start one HTTPS
+ server for each virtual host, each one listening on a different address. For the time
+ being, this method is applicable under Anubis only if you start as many instances of
+ 'anbexec' as you have virtual hosts, because each instance of 'anbexec' can handle only
+ one server certificate. Of course, getting IP aliases is another problem to be solved
+ with your Internet provider.
+
+ Solution 2. We propose a simple solution, using only one server certificate (hence
+ only one instance of 'anbexec'). Since, we have only one server certificate, we must
+ introduce a notion of 'main host', i.e. a host containing all other 'virtual
+ hosts'. The unique server certificate belong to the main host, so that only the main
+ host is identified by the client. The client must trust the main host and be confident
+ that the main host redirects him to the right virtual host. Actually, the process will
+ be transparent to the client, except that the client will see the name of the main host
+ instead of the name of the virtual host in the 'location' field of the browser.
+
+ So, assume that the name of main host is 'www.securedhost.com', and that the names of
+ the virtual hosts are:
+
+ actual name simplified name
+ -----------------------------------------------------
+ www.virtual1.com virtual1
+ www.virtual2.com virtual2
+ www.virtual3.com virtual3
+
+ Then the (confidential) document '/doc/my_document.pdf' on 'www.virtual2.com' will have
+ the URL:
+
+ https://www.securedhost.com/virtual2/doc/my_document.pdf
+
+ In order to work transparently, this solution must combine HTTP and HTTPS. Indeed, the
+ vitual host must have a first page reachable under HTTP, through the URL:
+
+ http://www.virtual2.com/
+
+ The HTTP server will redirect this URL to the awp handler of virtual host 'virtual2'.
+ The handler of this virtual host is able to generate a first page containing the
+ following HTML meta:
+
+ ,
+
+ so that the client is immediately redirected to the main host under HTTPS (hence
+ accepting tranparently the server certificate). The awp handler of 'virtual2' then
+ redirects this URL to the home page (maybe a login page) of 'virtual2'.
+
+ See 'web/making_a_web_site.anubis' for the sequel of this story.
+
+
+
+
+
+ *** (3) HTTP headers and web arguments.
+
+ Each HTTP request which arrives on the server contains a request line followed by a
+ series of HTTP headers. Each HTTP header is a pair '(name,value)' assigning a value to
+ a name. The type 'HTTP_header' is defined in 'web/common.anubis'.
+
+ The request may also have a 'body'. The body contains either 'web arguments' or
+ uploaded files (or both). The request line itself may also contain web arguments (in a
+ so-called 'query string'). Like HTTP headers, 'web arguments' are pairs
+ '(name,value)', but the difference is that these pairs are generated by the page within
+ which the client clicks, while HTTP headers are generated by the browser itself. The
+ type 'Web_arg' is defined in 'web/common.anubis'. It has two alternatives, one for
+ ordinary web arguments (pairs) and one for uploaded files.
+
+read CXM_common.anubis
+read tools/basis.anubis
+read system/string.anubis
+read CXM_mime.anubis
+
+
+
+ *** (4) Site descriptions.
+
+ The type HTTP_Info gathers informations comming along with the client's request. These
+ informations are rarely used for composing HTML pages. Nevertheless, they are at your
+ disposal.
+
+public type HTTP_Info:
+ http_info
+ (
+ Int32 ip_address, // IP address of the client
+ String uri, // URI requested by the client
+ List(HTTP_header) http_headers, // HTTP headers sent by the client
+ One -> String generate_trust_ticket // may be used against denial of
+ // service attacks
+ ).
+
+
+
+ Each site is described by a 'web site description', which is a datum of type
+ 'Web_Site_Description'.
+
+public type Web_Site_Description:
+ web_site_description(
+ List(String) common_names,
+ String site_directory,
+ List(Redirection) redirections,
+ String charset,
+ List(String) journal_extensions,
+ List(String) journal_headers,
+ String authorization_secret,
+ List(MIME) known_mime_types,
+ (String host_name,
+ HTTP_Info http_info,
+ List(Web_arg) lwa,
+ Bool is_https) -> (List(HTTP_header),
+ Printable_tree) awp_handler,
+ (List(Web_arg) lwa) -> One before_send_file).
+
+ The component 'common_names' is the list of names of the site, like for example
+ "www.our-business.com". The reason why we have a list of common names instead of a
+ single common name, is that it may be useful to have a common name like "192.168.0.1"
+ for testing.
+
+ 'charset' is a string which will determine the character encoding to be used by the
+ browser. Typically, this string is one of: "UTF-8", "ISO-8859-1", "Windows-1252",
+ etc...
+
+ 'journal_extensions' is the list of URI extensions for which you want a log in the
+ journal (and on the console). When a request arrives, and if the extension is a member
+ of this list, a message is printed into the journal of the site including the date, the
+ IP address of the client, the complete HTTP request line. The HTTP headers whose name
+ is a member of 'journal_headers' are also printed in the journal. A reasonable minimum
+ for these two components is:
+
+ [".awp"] for journal_extensions
+ ["user-agent"] for journal_headers
+
+ 'authorization_secret' is a string which should just be unguessable. You may choose
+ something like (but don't choose this one !):
+
+ "Hg8kJe42gCML9jNH-74"
+
+ i.e. a sequence of characters typed at random, long enough to be unguessable. This is
+ used by the 'private download' mecanism, which is discussed later in this file.
+
+ The component 'awp_handler' is a function of type:
+
+ (String host_name,
+ HTTP_Info http_info,
+ List(Web_arg) web_args,
+ Bool is_https) -> Printable_tree
+
+ ('Printable_tree' is a substitute for 'String' and is defined in
+ 'tools/basis.anubis'). This function is the 'awp handler' for the site. When the URI
+ ends by ".awp", this function is called, and the result (an HTML page) is sent to the
+ client over the connection. The last operand to this function is a boolean which is
+ 'true' when the requests arrives through the HTTPS channel, and 'false' when it arrives
+ through the HTTP channel.
+
+
+
+
+
+
+
+ *** (5) Protection against denial of service attacks.
+
+ We need to protect our servers against 'denial of service' attacks. The attack may be
+ send automatically from machines which are infested by viruses. In that case, our
+ server is saturated of connections (all virtual machines at work), but nothing is
+ comming on the connections. In order to avoid this problem, we propose the following:
+
+ (1) Limit the number of simultaneous connections (say to 100).
+ (2) Close a connection if the request is not complete after say 10 seconds.
+ (3) Close the connection if the request is bigger than a given size (normal requests
+ are small except when there are uploaded files.
+ (4) Close the connection during the sending of the answer if the client is waiting
+ too much.
+ (5) Record all IP addresses with which we have encountered one of the problems above.
+ (6) Immediately close the connections if the IP address is in our list.
+ (7) Remove an address from the list only after 5 minutes of inactivity of this
+ address.
+ (8) Maintain a list of reliable IP addresses.
+
+ Of course, all the above are approximative solutions which may in some circumstances
+ become either cumbersome or also partially block the system. So, it is needed to have a
+ set of dynamically modifiable parameters in order to master the behavior of this
+ mecanism.
+
+
+ Each dubious IP address is recorded together with its last activity time.
+
+public type DubiousIP:
+ dubious_ip (Int32 address,
+ Int32 last_activity).
+
+
+public type DenialOfService:
+ denial_of_service(Var(Int32) max_connections,
+ Var(Int32) request_line_delay, // seconds
+ Var(Int32) headers_delay,
+ Var(Int32) answer_delay,
+ Var(List(DubiousIP)) list_of_dubious,
+ Var(List(Int32)) reliable_addresses).
+
+ The informations in this set of variables are stored serialized into the file
+ 'my_anubis/web_sites/dos_info'. If this file does not exist a set if variables with
+ default values is created. The values are saved on the disk each time they are
+ modified.
+
+public define DenialOfService load_denial_of_service_info.
+
+
+
+ *** (6) Starting your HTTP and HTTPS servers.
+
+ When your web site descriptions are ready, you can start a pair of servers (a HTTP
+ server and a HTTPS server) for serving your web sites. Notice that there are always
+ two servers, regardless of the number of web sites, and that each web sites normally
+ uses the two servers.
+
+
+public define StartServerResult
+ start_http_server
+ (
+ Int32 ip_address,
+ Int32 http_port,
+ List(Web_Site_Description) web_sites,
+ DenialOfService dos
+ ).
+
+public define StartServerResult
+ start_https_server
+ (
+ Int32 ip_address,
+ Int32 https_port,
+ String certificate_common_name,
+ List(Web_Site_Description) web_sites,
+ DenialOfService dos
+ ).
+
+ The first argument 'ip_address' is the IP address on which the servers listen. If you
+ put 0, the servers listen on all adresses of the machine (which is useful if the
+ machine has several network interfaces). Otherwise, use the function 'ip_address'
+ defined in 'tools/basis.anubis' for composing a particular IP address.
+
+ The next arguments are the port numbers for HTTP and HTTPS. The usual values are 80 and
+ 443, but you may have reasons to choose other values.
+
+ The next argument is the list of your web site descriptions. All the sites described in
+ this list will be accessible on the server.
+
+ The argument 'dos' is a set of dynamic variables containing the informations for
+ protecting the servers against denial of service attacks.
+
+
+
+
+
+
+ *** (7) Private download.
+
+ It may happen that you want to propose private files for download. This means that such
+ a file could be downloaded only by the authorized person, and should not be seen by any
+ other one. This feature can be used only under HTTPS, not under HTTP.
+
+ The file may be located anywhere on the server. Hence, the file has a complete absolute
+ path, like for example:
+
+ /home/georges/my_documents/my_text.pdf
+
+ which has nothing to do with the directories of the web server. Now, you may also want
+ to show another path or simply just a name to the client, not the actual absolute path
+ above, which may need to remain secret. So for example, the same file may appear to the
+ client as:
+
+ informations.pdf
+
+ The page must provide a link with an authorization. The authorization is just a web
+ argument, whose name is "zauth". The value of this web argument is computed by hashing
+ some secret string (known only from the programmer of the web site) with the absolute
+ path of the file. The HTTPS request will have the form:
+
+ GET /informations.pdf?zauth=d38161f5b4e87e2d46e06ff8b3e233be563794d1
+
+ The server will search for a file named
+
+ zd38161f5b4e87e2d46e06ff8b3e233be563794d1
+
+ (i.e. "z" concatenated with the value of the authorization) in the subdirectory
+ 'private_download' of the site directory. This file contains the absolute path of the
+ file, i.e:
+
+ /home/georges/my_documents/my_text.pdf
+
+ At that point, the server may hash the secret string and the absolute path together, to
+ check if the client is authorized to download the file. If it is the case, it sends the
+ file (the MIME type is declared as 'application/octet-stream' if it is not recognized).
+ The file is sent under the visible name.
+
+ The server creates automatically the subdirectory 'private_download/' within the 'site
+ directory' (for each web site) if it does not already exist. Files in this directory
+ are deleted when they become too old (for example, after 3 days of life).
+
+ Here is the function for computing the value of the authorization, and for making the
+ authorization file in 'private_download'.
+
+public define String
+ make_authorization
+ (
+ String site_directory,
+ String authorization_secret, // known only by the programmer of the web site
+ String absolute_path // on server
+ ).
+
+ See 'web/making_a_web_site.anubis' for the construction of the link for downloading.
+
+
+
+
+
+
+
+
+ *** (8) About web argument names.
+
+ The server reserves the name "zauth" for the authorization in the private download
+ mecanism. Also, if the name of a web arguments begins by "p" (like 'password'), it does
+ not print the value of the web argument neither on the console or in the journal. A
+ good politics is to prefix all web arguments by letters distinct from 'p' and 'z'. This
+ method is used in 'web/making_a_web_site.anubis'. This will avoid clashes of names.
+
+
+
+
+
+
+ *** (9) A web dispatcher.
+
+ For hosting several sites you may prefer another method which we now describe. We start
+ a HTTP server on port 80 (or on another port). This server is called the
+ ``dispatcher''. When a requests arrives, the dispatcher examines the ``host'' HTTP
+ header, so that it gets the name of the requested host. Then it sends to the client a
+ page like this one:
+
+
+
+
+
+
+
+
+
+ where the URL represented by '...' is the URL of the requested site. This URL may have
+ the same IP address as the dispatcher, except that the port number is different. It may
+ also have a different IP address.
+
+ The dispatcher uses the file 'my_anubis/web_sites/dispatcher.info'. This file contains
+ a serialized datum of type 'List(DispatcherInfo)'.
+
+public type DispatcherInfo:
+ site(String common_name,
+ Int32 http_port).
+
+ The dispatcher does not write into this file. It reads it when it starts, and rereads
+ it each time the date of last modification of the file changes, so that the dispatcher
+ always has up to date data. The file may be managed (written and updated) by another
+ program.
+
+ So, for each site, the dispatcher knows the common name (needed to recognize the 'host'
+ HTTP header), and the pair (ip_address,port) used by the actual site for HTTP. The
+ dispatcher does not worry about HTTPS. HTTPS must be managed by the actual site.
+
+ The dispatcher is started by:
+
+public define One
+ start_web_dispatcher
+ (
+ Int32 ip_address, // address for listening (typically 0)
+ Int32 port, // typically 80
+ DenialOfService dos
+ ).
+
+ A command line tool for managing the file 'my_anubis/web_sites/dispatcher.info' is also
+ provided:
+
+ global define One
+ manage_web_dispatcher
+ (
+ List(String) args
+ ).
+
+
+
+
+
+
+
+ --- That's all for the public part ! --------------------------------------------------
+
+
+
+
+
+
+
+ ----------------------------------- Table of Contents ---------------------------------
+
+ *** [1] Types which are private to this file.
+
+ *** [2] Tools.
+ *** [2.1] Formating an error message.
+ *** [2.2] Converting IP addresses.
+ *** [2.3] Reading and unputting characters.
+ *** [2.4] Reading and discarding characters.
+ *** [2.5] Reading a character string.
+ *** [2.6] Padding integers with zeros.
+ *** [2.7] Converting web arguments to ASCII.
+ *** [2.8] Server description.
+
+ *** [3] Managing the journal.
+ *** [3.1] Naming journal files.
+ *** [3.2] Formating HTTP headers.
+ *** [3.3] Formating web arguments.
+ *** [3.4] Formating the whole request.
+ *** [3.5] Putting it in the journal file (and on the console).
+
+ *** [4] Reading the HTTP request.
+ *** [4.1] Skipping leading blanks.
+ *** [4.2] Reading a new line.
+ *** [4.3] Reading a 'word'.
+ *** [4.4] Separating the URI from the query string.
+ *** [4.5] Reading the web arguments.
+ *** [4.7] Reading the request line.
+ *** [4.8] Reading the HTTP headers.
+ *** [4.9] Getting the size of the request's body.
+ *** [4.10] Reading the body of the request.
+
+ *** [5] Making the HTTP answer.
+ *** [5.1] Avoiding illegal URIs.
+ *** [5.2] Managing authorizations for downloading private files.
+ *** [5.3] Recognizing MIME types.
+ *** [5.4] Formating HTTP headers.
+ *** [5.5] Sending a file.
+ *** [5.6] Answering a www-url encoded request.
+ *** [5.7] Answering a multipart/form-data encoded request.
+ *** [5.7.1] Finding the boundary.
+ *** [5.7.2] Reading attributes from a multipart entity.
+ *** [5.7.3] Creating a temporary filename for an uploaded file.
+ *** [5.7.4] Saving an uploaded file under a temporary filename.
+ *** [5.7.5] Removing the path from a file name.
+ *** [5.7.6] Reading a multipart entity.
+ *** [5.8] Handling redirections.
+ *** [5.9] Answering both sorts of requests.
+
+ *** [6] The HTTP/HTTPS servers.
+ *** [6.1] The HTTP request handler.
+ *** [6.2] Server's tasks.
+ *** [6.3] Starting the HTTP/HTTPS servers.
+
+ *** [7] The web dispatcher.
+ *** [7.1] The dispatcher server.
+ *** [7.2] The dispatcher web site.
+ *** [7.3] Managing the info file.
+
+ ---------------------------------------------------------------------------------------
+
+
+
+
+read tools/basis.anubis
+read tools/findstring.anubis
+read tools/connections.anubis
+
+
+
+
+
+ *** [1] Types which are private to this file.
+
+ We use the following self-explanatory types.
+
+type Error:
+ cannot_read_from_connection,
+ not_get_or_post_request(String),
+ end_of_line_expected,
+ incorrect_content_length_value,
+ colon_expected,
+ timeout(Int32).
+
+type HTTP_RequestType:
+ get,
+ post.
+
+type HTTP_RequestLine:
+ request_line (HTTP_RequestType type,
+ String uri,
+ List(Web_arg) query_string).
+
+type EncodingType:
+ www_url,
+ multipart_form_data.
+
+
+
+
+
+ *** [2] Tools.
+
+ *** [2.1] Formating an error message.
+
+ The next function formats an error message.
+
+define String
+ format
+ (
+ Error msg
+ ) =
+ if msg is
+ {
+ cannot_read_from_connection then
+ "Cannot read from connection.\n",
+ not_get_or_post_request(s) then
+ "The request did not begin by 'GET' or 'POST': "+s+".\n",
+ end_of_line_expected then
+ "End of line expected.\n",
+ incorrect_content_length_value then
+ "Incorrect value for HTTP header 'Content-Length'.\n",
+ colon_expected then
+ "':' was expected.\n",
+ timeout(n) then
+ //"time out: "+n+"\n"
+ //"time out.\n"
+ ""
+ }.
+
+
+
+
+
+
+ *** [2.2] Converting IP addresses.
+
+ We need two conversion functions for IP addresses:
+
+ (Word8,Word8,Word8,Word8) --> Int32 ip_address
+ Int32 --> String ip_addr_to_string
+
+ These conversions are defined in 'tools/basis.anubis'.
+
+
+
+
+
+
+
+
+ *** [2.3] Reading and unputting characters.
+
+ We need a mecanism for unputting several characters (actually at least 3). This is
+ because when reading the client connection, we must sometimes go ahead several
+ characters, and virtually put them back into the connection, so that they can be
+ reread. Of course, we do not send them back to the client. We store them in a list
+ (hold by the variable 'unput_chars'), and we manage this list, so that characters may
+ be virtually put back in the connection (this is called 'unputting').
+
+variable List(Word8) unput_chars = [].
+
+ The most recently read one is the head of list. Fortunately, this variable is private
+ to this virtual machine (hence to this client).
+
+
+define One
+ unput // unputting a character (add it in front of the list)
+ (
+ Word8 character
+ ) =
+ unput_chars <- (List(Word8))[character . *unput_chars].
+
+
+
+define One record_dubious_IP(Int32 addr,DenialOfService dos).
+
+variable Int32 sttm = 0. // contains the start time for this connection.
+
+define Result(Error,Word8)
+ record_dubious_connection
+ (
+ Connection conn,
+ Int32 dead_line,
+ DenialOfService dos,
+ ) =
+ if remote_IP_address_and_port(conn) is (addr,port) then
+ record_dubious_IP(addr,dos);
+ print("Recording IP address "+ip_addr_to_string(addr)+
+ " as dubious after "+(dead_line-*sttm)+" seconds. Total: "+
+ length(*list_of_dubious(dos))+"\n");
+ error(timeout(dead_line)).
+
+
+define Result(Error,Word8)
+ read_one_byte
+ (
+ Connection connection,
+ Int32 dead_line,
+ DenialOfService dos
+ ) =
+ //if now > dead_line then record_dubious_connection(connection,dead_line,dos) else
+ if read(connection,1,600) is // the connection is closed after 10 minutes of inactivity
+ {
+ error then error(cannot_read_from_connection),
+ timeout then error(timeout(600)),
+ //record_dubious_connection(connection,dead_line,dos),
+ ok(ba) then if nth(0,ba) is
+ {
+ failure then error(cannot_read_from_connection),
+ success(c) then ok(c)
+ }
+ }.
+
+
+define Result(Error,Word8)
+ next_char // reading a character (check the list first, and read on the connection
+ // only when the list is empty).
+ (
+ Connection connection,
+ Int32 dead_line,
+ DenialOfService dos
+ ) =
+ if *unput_chars is
+ {
+ [ ] then read_one_byte(connection,dead_line,dos),
+
+ [h . t] then
+ unput_chars <- t;
+ ok(h)
+ }.
+
+
+
+
+
+
+
+ *** [2.4] Reading and discarding characters.
+
+ The next function reads the specified number of bytes (this is the same as
+ 'characters') from the connection and discards them. This is used for discarding CR LF
+ just before the body of a request.
+
+define Result(Error,One)
+ read_and_ignore
+ (
+ Connection connection, // to client
+ Int32 dead_line,
+ Int32 number_of_characters, // number of characters to read and ignore
+ DenialOfService dos
+ ) =
+ if number_of_characters =< 0 then ok(unique) else
+ if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(c) then read_and_ignore(connection,dead_line,number_of_characters-1,dos)
+ }.
+
+
+
+
+
+
+
+ *** [2.5] Reading a character string.
+
+ Sometimes values of HTTP attributes or web args are presented in the form of double
+ quoted strings. The next function handles the reading of such things. The leading
+ double quote is already read in. We must read subsequent characters until the next non
+ backslashed double quote.
+
+define Result(Error,String)
+ read_string
+ (
+ Connection connection, // connection with the client
+ Int32 dead_line,
+ List(Word8) so_far, // characters read so far (in reverse order)
+ DenialOfService dos
+ ) =
+ if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(c) then
+ if c = '\\'
+ then if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(d) then
+ if d = '\"'
+ then read_string(connection,dead_line,['\"' . so_far],dos)
+ else read_string(connection,dead_line,[d, c . so_far],dos)
+ }
+ else if c = '\"'
+ then ok(implode(reverse(so_far)))
+ else read_string(connection,dead_line,[c . so_far],dos)
+ }.
+
+
+
+
+
+
+
+ *** [2.6] Padding integers with zeros.
+
+ 'zero_pad_2' transforms an integer (which is assumed to be between 0 and 99) into a
+ string with exactly two digits. This is used for formating days, hours, minutes and
+ seconds.
+
+define String
+ zero_pad_2
+ (
+ Int32 n
+ ) =
+ with s = integer_to_string(n),
+ if length(s) < 2
+ then "0"+s
+ else s.
+
+
+
+
+
+
+
+ *** [2.7] Converting web arguments to ASCII.
+
+ The function 'web_to_ascii' gets a character string and replaces web encoding by normal
+ ASCII encoding. This amounts to replacing:
+
+ + by blank
+ %xx by the character whose ASCII code is xx in hexadecimal
+
+ Note: We assume that '9' < 'A' (which is the case for ASCII code).
+
+
+
+define Word8
+ web_decode
+ (
+ Word8 x1,
+ Word8 x2
+ ) =
+ with z1 = word8_to_int32(x1),
+ n1 = if z1 =< '9' then (z1 - '0') else (z1 - 'A' + 10),
+ z2 = word8_to_int32(x2),
+ n2 = if z2 =< '9' then (z2 - '0') else (z2 - 'A' + 10),
+ n = (n1 << 4) + n2,
+ truncate_to_word8(n).
+
+
+
+define String
+ web_to_ascii
+ (
+ String web_string,
+ Int32 n, // current position in web_string
+ List(Word8) so_far
+ ) =
+ if nth(n,web_string) is
+ {
+ failure then implode(reverse(so_far)),
+ success(c) then
+ if c = '+'
+ then web_to_ascii(web_string,n+1,[' ' . so_far])
+ else if c = '%'
+ then if nth(n+1,web_string) is
+ {
+ failure then implode(reverse(so_far)),
+ success(x1) then if nth(n+2,web_string) is
+ {
+ failure then implode(reverse(so_far)),
+ success(x2) then web_to_ascii(web_string,n+3,[web_decode(x1,x2) . so_far])
+ }
+ }
+ else web_to_ascii(web_string,n+1,[c . so_far])
+ }.
+
+
+
+
+
+
+
+
+ *** [3] Managing the journal.
+
+ Concurrently working machines should not try to access the same file at the same
+ time. This problem may be solved by using the 'protect' mecanism.
+
+
+
+ *** [3.1] Naming journal files.
+
+ Since journal messages are rather prolific, we should have at least one file per
+ hour. Hence, the name of a journal file must be constructed from the current year,
+ month, day and hour. For example, it may be:
+
+ 2003_03_12_19
+
+ (this is for the journal of 7 PM to 8 PM, 2003/mar/12).
+
+define String
+ make_current_journal_file_name
+ =
+ if convert_time(now) is date_and_time(y,m,d,h,_,_,_,_,_) then
+ integer_to_string(y)+"_"+
+ zero_pad_2(m)+"_"+
+ zero_pad_2(d)+"_"+
+ zero_pad_2(h).
+
+
+
+
+
+
+
+ *** [3.2] Formating HTTP headers.
+
+ HTTP headers may be shown on the console or written in the journal. The function below
+ formats a list of HTTP headers.
+
+define String
+ show_format
+ (
+ Web_Site_Description desc,
+ List(HTTP_header) headers,
+ ) =
+ if headers is
+ {
+ [ ] then "",
+ [h . t] then if h is http_header(name,value) then
+ if member(journal_headers(desc),name)
+ then " | "+name+": "+value+"\n"+show_format(desc,t)
+ else show_format(desc,t)
+ }.
+
+
+
+
+
+
+ *** [3.3] Formating web arguments.
+
+ The same thing for web arguments.
+
+define String
+ show_format
+ (
+ List(Web_arg) lwa
+ ) =
+ if lwa is
+ {
+ [ ] then "",
+ [h . t] then if h is
+ {
+ web_arg(n,v) then
+ " | "+n+"="+(if nth(0,n) = success('p') then "" else v)+"\n"+show_format(t),
+ upload(n,fn,tfn) then
+ " | "+n+"="+fn+" (uploaded as '"+tfn+"')\n"+show_format(t)
+ }
+ }.
+
+
+
+
+
+
+ *** [3.4] Formating the whole request.
+
+ It is cheap to transform month numbers into abbreviated month names. This enhances the
+ readability of the journal.
+
+define String
+ format_month
+ (
+ Int32 m
+ ) =
+ if m = 1 then "jan" else
+ if m = 2 then "feb" else
+ if m = 3 then "mar" else
+ if m = 4 then "apr" else
+ if m = 5 then "may" else
+ if m = 6 then "jun" else
+ if m = 7 then "jul" else
+ if m = 8 then "aug" else
+ if m = 9 then "sep" else
+ if m = 10 then "oct" else
+ if m = 11 then "nov" else
+ if m = 12 then "dec" else
+ "???".
+
+
+ Below we format a whole HTTP request. This may give this (actually, it depends on how
+ you defined the values of 'journal_headers' and 'journal_extensions'):
+
+ [3] 2003/mar/10 10:06:57 from 123.456.123.456: /homepage.awp
+ | host: www.the-best-one.com
+ | user-agent: Mozilla/5.0 (X11; U; Linux i686; en-US; rv:1.0.1) Gecko/20020823 Netscape/7.0
+
+ The leading number between brackets is the number of the virtual machine which served
+ the URI.
+
+define String
+ format_request
+ (
+ Web_Site_Description desc,
+ Connection client_connection,
+ HTTP_RequestLine request_line,
+ List(HTTP_header) headers,
+ List(Web_arg) web_args
+ ) =
+ with dt = convert_time(now),
+ if remote_IP_address_and_port(client_connection) is (addr,port) then
+ integer_to_string(year(dt))+"/"+format_month(month(dt))+"/"+zero_pad_2(day(dt))+" "+
+ zero_pad_2(hour(dt))+":"+zero_pad_2(minute(dt))+":"+zero_pad_2(second(dt))+
+ " from "+ip_addr_to_string(addr)+
+ ": "+uri(request_line)+"\n"+
+ show_format(desc,headers)+
+ show_format(web_args).
+
+
+
+
+
+
+
+ *** [3.5] Putting it in the journal file (and on the console).
+
+ We must not forget to 'protect' this operation, so that the messages of two machines
+ (working for the same site) will not be mixed together.
+
+define One
+ log_journal_msg
+ (
+ Web_Site_Description desc,
+ String msg,
+ ) =
+ with msg = to_byte_array("["+virtual_machine_id+"] "+msg+"\n"),
+ protect
+ (
+ if file(site_directory(desc)+"/journal/"+make_current_journal_file_name,append) is
+ {
+ failure then unique,
+ success(journal_file) then
+ forget(reliable_write(file(journal_file),msg))
+ };
+ forget(reliable_write(file(stdout),msg))
+ ).
+
+
+
+
+
+
+
+ *** [4] Reading the HTTP request.
+
+
+ *** [4.1] Skipping leading blanks.
+
+ One of the peculiarities of HTTP is that the characters 13 (carriage return) and 10
+ (line feed) followed by either a space (32) or a tab (9), is considered as a blank not
+ containing any new line. 'skip_http_blanks' must skip all blanks characters until the
+ first non blank character, which should not be read in. Obviously, because of the above
+ peculiarity, we need at least 3 characters of lookahead to do this. In other words, we
+ must be able to unput at least 3 characters (hopefully we are).
+
+ Strictly blanks characters are 'space' and 'tab'.
+
+define Bool
+ is_strict_blank
+ (
+ Word8 c
+ ) =
+ if c = ' ' then true else c = '\t'.
+
+
+ On the contrary, blanks include 13 and 10.
+
+define Bool
+ is_blank
+ (
+ Word8 c
+ ) =
+ if c = ' ' then true else
+ if c = '\t' then true else
+ if c = 13 then true else
+ c = 10.
+
+
+ Skipping HTTP blanks.
+
+define Result(Error,One)
+ skip_http_blanks
+ (
+ Connection connection,
+ Int32 dead_line,
+ DenialOfService dos
+ ) =
+ if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(c) then
+ if is_strict_blank(c)
+ then skip_http_blanks(connection,dead_line,dos)
+ else if c = 13
+ then if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg), // (unput(c); ok(unique)),
+ ok(d) then
+ if d = 10
+ then if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg), // (unput(d); unput(c); ok(unique)),
+ ok(e) then
+ if is_strict_blank(e)
+ then skip_http_blanks(connection,dead_line,dos)
+ else (unput(e); unput(d); unput(c); ok(unique))
+ }
+ else (unput(d); unput(c); ok(unique))
+ }
+ else (unput(c); ok(unique))
+ }.
+
+
+
+
+
+
+
+
+ *** [4.2] Reading a new line.
+
+ Normally in HTTP a new line is the sequence 13 10 (carriage return line feed), not
+ followed by a space or tabulator. If it is followed by a space or tabulator, the three
+ characters are considered blanks, and no new line has been read. Before trying to read
+ a new line, we first skip leading spaces and tabs. Then we try to read 13 and 10, and
+ we read another character. if this character is space or tab, we consider we have read
+ only blanks and we continue reading in order to find our new line. Otherwise, we unput
+ this character (which may be for example the first character of the name of the next
+ header), and answer that we have seen a new line.
+
+ Warning: we must not use this function for reading the last pair (13,10) before the
+ beginning of the body, because if the body is empty, there is no character to read
+ after this pair, so that the server could wait for a character which will never
+ come. This is the reason for 'read_and_ignore' above, which is used precisely for
+ reading that last (13,10) pair.
+
+define Result(Error,One)
+ read_new_line
+ (
+ Connection connection,
+ Int32 dead_line,
+ DenialOfService dos
+ ) =
+ if skip_http_blanks(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(_) then
+ if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(c) then
+ if c = 13
+ then if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(d) then
+ if d = 10
+ then ok(unique)
+ else (unput(d);
+ unput(c);
+ error(end_of_line_expected))
+ }
+ else (unput(c);
+ error(end_of_line_expected))
+ }}.
+
+
+
+
+
+
+
+
+ *** [4.3] Reading a 'word'.
+
+ A 'word' is a sequence of characters which begins either by a double quote or not by a
+ double quote. (However, any leading blanks are read in and ignored. This is
+ accomplished by 'skip_http_blanks'.) If it begins by a double quote, it is read like a
+ string, i.e. it ends at the next (non backslashed) double quote. Otherwise, it is
+ right delimited by any character which may be considered as 'blank'. If the word is
+ double quoted, the closing double quote is read in. On the contrary, if the word is not
+ double quoted, the right delimiting blank character is not read in (it is 'unput' back
+ into the connection), and may be read in again. This is needed because carriage return
+ or line feed which are 'blank', also have a meaning in HTTP.
+
+define Result(Error,String)
+ read_word_aux
+ (
+ Connection connection,
+ Int32 dead_line,
+ List(Word8) so_far,
+ DenialOfService dos
+ ) =
+ if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(c) then
+ if is_blank(c)
+ then (unput(c);
+ ok(implode(reverse(so_far))))
+ else read_word_aux(connection,dead_line,[c . so_far],dos)
+ }.
+
+define Result(Error,String)
+ read_word
+ (
+ Connection connection,
+ Int32 dead_line,
+ DenialOfService dos
+ ) =
+ if skip_http_blanks(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(_) then
+ if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(c) then
+ if c = '\"'
+ then read_string(connection,dead_line,[],dos)
+ else read_word_aux(connection,dead_line,[c],dos)
+ }
+ }.
+
+
+
+
+
+
+
+
+ *** [4.4] Separating the URI from the query string.
+
+ A 'query string' may be postfixed to the URI, just after a question mark. For example,
+ the client may send the following request:
+
+ GET /catalog.awp?item=3&color=blue
+
+ We separate this into an URI: "/catalog.awp" and the string: "item=3&color=blue" which
+ will be later transformed into the list:
+
+ [web_arg("item","3"),web_arg("color","blue")]
+
+
+define (String,String)
+ separate_uri_from_query_string
+ (
+ String uri_and_query_string,
+ Int32 n
+ ) =
+ if nth(n,uri_and_query_string) is
+ {
+ failure then (uri_and_query_string,""),
+ success(c) then
+ if c = '?'
+ then (substr(uri_and_query_string,0,n),
+ substr(uri_and_query_string,n+1,length(uri_and_query_string)-(n+1)))
+ else separate_uri_from_query_string(uri_and_query_string,n+1)
+ }.
+
+
+
+
+
+
+
+
+
+ *** [4.5] Reading the web arguments.
+
+ HTTP/HTTPS requests are sent in one of two formats:
+
+ (1) www-url encoded
+ (2) multipart/form-data encoded
+
+ The first one is the normal (historical) way of encoding. The second one is required
+ for uploading files. A server which is supposed to accept upload of files must handle
+ both formats. The first thing to do is to decide the format of the request. This is
+ easily done by examining the HTTP headers. If we find the header:
+
+ Content-Type: multipart/form-data
+
+ the request is multipart/form-data encoded. Otherwise, it is 'www-url' encoded. We
+ first consider 'www-url' encoded requests.
+
+ For a 'www-url' encoded request, the web argument are either in the query string or in
+ the body of the request, or both. The format is the same for both:
+
+ name=value&name=value&...
+
+ However, we may also have
+
+ name
+ name=
+ name=&...
+ name&...
+
+ i.e. some parts may be missing. Hence, we must be careful.
+
+ Furthermore, web arguments must be translated from web to ASCII when www-url encoded.
+
+define Bool
+ is_ampersand_or_equal
+ (
+ Word8 c
+ ) =
+ if c = '&' then true else c = '='.
+
+
+
+ The function 'read_name_or_value' reads the string 's' starting at position 'n' until
+ either the end of the string or the first '&' or '='.
+
+define String
+ read_name_or_value
+ (
+ String s,
+ Int32 start,
+ Int32 i
+ ) =
+ if nth(i,s) is
+ {
+ failure then substr(s,start,i - start),
+ success(c) then
+ if is_ampersand_or_equal(c)
+ then substr(s,start,i-start) // the separator is not included
+ else read_name_or_value(s,start,i+1)
+ }.
+
+
+define List(Web_arg)
+ read_www_url_encoded_web_args
+ (
+ String s,
+ Int32 start,
+ ) =
+ with first = read_name_or_value(s,start,start),
+ if first = ""
+ then []
+ else with i = start+length(first),
+ if nth(i,s) is
+ {
+ failure then [web_arg(first,"")],
+ success(c) then
+ if c = '&'
+ then [web_arg(first,"") . read_www_url_encoded_web_args(s,i+1)]
+ else if c = '='
+ then with second1 = read_name_or_value(s,i+1,i+1),
+ // print("\""+second1+"\"\n");
+ with second = web_to_ascii(second1,0,[]),
+ [web_arg(first,second) . read_www_url_encoded_web_args(s,i+length(second1)+2)]
+ else alert
+ }.
+
+
+
+
+
+ *** [4.7] Reading the request line.
+
+ 'read_request_line' reads three words and a new line from the connection. It tries to
+ recognize "GET" or "POST" in the first word, separates the URI from the query string in
+ the second word, transforms the query string into a list of 'Web_arg', and finally
+ returns a datum of type 'HTTP_RequestLine' if no error arose.
+
+
+define Result(Error,HTTP_RequestType)
+ identify_get_or_post
+ (
+ String s
+ ) =
+ with s = to_lower(s),
+ if s = "get" then ok(get) else
+ if s = "post" then ok(post) else
+ error(not_get_or_post_request(s)).
+
+define Result(Error,HTTP_RequestLine)
+ read_request_line
+ (
+ Connection connection,
+ Int32 dead_line,
+ DenialOfService dos
+ ) =
+ if read_word(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(get_or_post) then if read_word(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(uri_and_query_string) then if read_word(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(http_version) then if read_new_line(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(_) then if separate_uri_from_query_string(uri_and_query_string,0) is
+ (uri,query_string) then if identify_get_or_post(get_or_post) is
+ {
+ error(msg) then error(msg),
+ ok(request_type) then
+ ok(request_line(request_type,uri,read_www_url_encoded_web_args(query_string,0)))
+ }
+ }
+ }
+ }
+ }.
+
+
+
+
+
+
+
+ *** [4.8] Reading the HTTP headers.
+
+ Each header is made of a name (containing only letters, the underscore, digits and the
+ minus sign), a colon, a value, and a new line. The first empty line ends the headers.
+
+
+ The next function tests characters acceptable in a header name.
+
+define Bool
+ is_header_name_char
+ (
+ Word8 c
+ ) =
+ with n = word8_to_int32(c),
+ if ('a' =< n & n =< 'z') then true else
+ if ('A' =< n & n =< 'Z') then true else
+ if ('0' =< n & n =< '9') then true else
+ if c = '-' then true else
+ c = '_'.
+
+define Result(Error,String)
+ read_header_name
+ (
+ Connection connection,
+ Int32 dead_line,
+ List(Word8) so_far,
+ DenialOfService dos
+ ) =
+ if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(c) then
+ if is_header_name_char(c)
+ then read_header_name(connection,dead_line,[to_lower(c) . so_far],dos)
+ else unput(c); ok(implode(reverse(so_far)))
+ }.
+
+define Result(Error,One)
+ skip_colon
+ (
+ Connection connection,
+ Int32 dead_line,
+ DenialOfService dos
+ ) =
+ if skip_http_blanks(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(_) then
+ if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(c) then
+ if c = ':'
+ then ok(unique)
+ else error(colon_expected)
+ }}.
+
+
+define Result(Error,String)
+ read_header_value
+ (
+ Connection connection,
+ Int32 dead_line,
+ List(Word8) so_far,
+ DenialOfService dos
+ ) =
+ if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(c) then
+ if c = 13
+ then if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(d) then
+ if d = 10
+ then if next_char(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(e) then
+ if is_strict_blank(e)
+ then read_header_value(connection,dead_line,[e . so_far],dos)
+ else (unput(e); ok(implode(reverse(so_far))))
+ }
+ else read_header_value(connection,dead_line,[d, c . so_far],dos)
+ }
+ else read_header_value(connection,dead_line,[c . so_far],dos)
+ }.
+
+
+ Reading a single header.
+
+define Result(Error,Maybe(HTTP_header))
+ read_header
+ (
+ Connection connection,
+ Int32 dead_line,
+ DenialOfService dos
+ ) =
+ if read_header_name(connection,dead_line,[],dos) is
+ {
+ error(msg) then error(msg),
+ ok(name) then
+ if name = "" then
+ if read_and_ignore(connection,dead_line,2,dos) /* 13 and 10 */ is
+ {
+ error(msg) then error(msg),
+ ok(_) then // this is the blank line
+ ok(failure) // end of headers
+ }
+ else if skip_colon(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(_) then if skip_http_blanks(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(_) then if read_header_value(connection,dead_line,[],dos) is
+ {
+ error(msg) then error(msg),
+ ok(value) then
+ ok(success(http_header(name,value)))
+ }
+ }
+ }
+ }.
+
+
+
+ Reading all the headers.
+
+define Result(Error,List(HTTP_header))
+ read_http_headers
+ (
+ Connection connection,
+ Int32 dead_line,
+ DenialOfService dos
+ ) =
+ if read_header(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(mbh) then if mbh is
+ {
+ failure then ok([ ]),
+ success(header) then
+ if read_http_headers(connection,dead_line,dos) is
+ {
+ error(msg) then error(msg),
+ ok(others) then ok([header . others])
+ }
+ }
+ }.
+
+
+
+
+
+
+
+ *** [4.9] Getting the size of the request's body.
+
+ The size of the body of the request is given under the 'Content-Length' header. If this
+ header is not present, the size is assumed to be zero.
+
+define Result(Error,Int32)
+ get_body_size
+ (
+ List(HTTP_header) headers
+ ) =
+ if headers is
+ {
+ [ ] then ok(0),
+ [h . t] then if h is http_header(name,value) then
+ if name = "content-length"
+ then if string_to_integer(value) is
+ {
+ failure then error(incorrect_content_length_value),
+ success(n) then ok(n)
+ }
+ else get_body_size(t)
+ }.
+
+
+
+
+
+
+
+
+
+
+ *** [4.10] Reading the body of the request.
+
+ The body of the request may be very big (it contains uploaded files, if any). We read
+ it using the primitive 'read', which returns the number of bytes read, which may be
+ less than the number of bytes we wanted to read. This is not an error, but simply due
+ to the fact the buffer associated with the connection in the Linux (or MS-Windows)
+ kernel has a limited size. Hence, we must read bytes again until we have read the
+ required number of bytes. However, if the number of bytes read is zero, the connection
+ may be broken. In that case, we must not try to read indefinitely. On the contrary, we
+ make at most 10 retries, with a small sleeping time between any two of them.
+
+define Result(Error,ByteArray)
+ read_http_body
+ (
+ Connection connection,
+ Int32 body_size,
+ ByteArray so_far, // when calling this function, 'so_far' is the empty byte array
+ Int32 retries // this function is called with retries = 10
+ ) =
+ if body_size = 0 then ok(constant_byte_array(0,0)) else
+ if retries =< 0 then error(cannot_read_from_connection) else
+ if read(connection,body_size,60) is
+ {
+ error then error(cannot_read_from_connection),
+ timeout then error(timeout(60)),
+ ok(new_bytes) then with
+ ba = so_far + new_bytes, // contains all the bytes read so far
+ nr = length(ba), // total read since the beginning
+ nn = length(new_bytes), // number of bytes just read
+ if nr < body_size // must read more bytes
+ then if nn > 0 // if connection seems to work
+ then read_http_body(connection,body_size,ba,1000) // continue reading
+ else sleep(100); // otherwise, sleep 1/10 of second
+ read_http_body(connection,body_size,ba, // and retry reading
+ retries-1) // but no more than 10 times
+ else ok(ba) // required number of bytes has been read
+ }.
+
+
+ Note: During sleeping, 'anbexec' runs other machines. Actually, calling 'sleep', even
+ for one millisecond, is some way of giving up explicitly, so that other virtual
+ machines may work.
+
+
+
+
+
+
+
+
+
+
+
+
+ *** [5] Making the HTTP answer.
+
+ At that point we have read the request line, the headers and the body of the
+ request, and we must decide what to do.
+
+ Actually, we can do one of the following:
+
+ - send a file,
+ - execute 'tickets_and_web_page' in case of an ".awp" URI.
+
+ The uploaded file (which are in the body of the request) are saved into temporary files
+ below.
+
+
+
+
+
+ *** [5.1] Avoiding illegal URIs.
+
+ For security reasons, we must avoid illegal URIs, for example those which may climb up
+ in the file hierarchy. First we accept only few characters in URIs.
+
+define Bool
+ is_legal_uri_char
+ (
+ Word8 c
+ ) =
+ with n = word8_to_int32(c),
+ if ('a' =< n & n =< 'z') then true else // accept 'a' to 'z'
+ if ('A' =< n & n =< 'Z') then true else // accept 'A' to 'Z'
+ if ('0' =< n & n =< '9') then true else // accept '0' to '9'
+ if c = '.' then true else // accept '.' '-' '/' and '_'
+ if c = '-' then true else
+ if c = '/' then true else
+ c = '_'.
+
+ We do not accept ~ which is some way of climbing. Of course, we cannot disallow single
+ dots, which are most often present in legal URIs, but we must avoid double dots ..
+ which mean 'climb up'.
+
+define Bool
+ is_illegal_uri
+ (
+ String uri,
+ Int32 n
+ ) =
+ if nth(n,uri) is
+ {
+ failure then false,
+ success(c) then
+ if c = '.' // first dot
+ then if nth(n+1,uri) is
+ {
+ failure then false,
+ success(d) then
+ if d = '.' // second dot
+ then true
+ else is_illegal_uri(uri,n+1)
+ }
+ else is_illegal_uri(uri,n+1)
+ }.
+
+
+
+
+
+
+ *** [5.2] Managing authorizations for downloading private files.
+
+ Computing the authorization and making the authorization file (containing the absolute
+ path of the file on the server).
+
+
+define String
+ compute_authorization
+ (
+ String authorization_secret,
+ String absolute_path
+ ) =
+ to_ascii(sha1((authorization_secret,
+ absolute_path))).
+
+
+public define String
+ make_authorization
+ (
+ String site_directory,
+ String authorization_secret,
+ String absolute_path
+ ) =
+ with private_download_dir = site_directory+"/private_download",
+ auth = compute_authorization(authorization_secret,
+ absolute_path),
+ forget(save(absolute_path,
+ private_download_dir+"/z"+auth));
+ auth.
+
+
+ The function 'send_file' defined below handles the recognition of authorizations.
+
+
+
+
+
+ *** [5.3] Recognizing MIME types.
+
+ The extension of the (redirected) URI must be either ".awp" or recognized as associated
+ to a MIME type. Otherwise, the server will not send the file. This is for security, but
+ also because, we must generate a 'Content-Type' header in the answer, with the right
+ MIME type.
+
+define String
+ get_uri_extension_aux
+ (
+ String uri,
+ Int32 n // used for searching backwards
+ ) =
+ if nth(n,uri) is
+ {
+ failure then "",
+ success(c) then
+ if c = '.' then substr(uri,n,length(uri)-n)
+ else if c = '/' then ""
+ else get_uri_extension_aux(uri,n-1)
+ }.
+
+public define String
+ get_uri_extension
+ (
+ String uri
+ ) =
+ get_uri_extension_aux(uri,
+ length(uri)-1). // search starts at the right end
+
+
+
+define Maybe(String)
+ recognize_mime_type_from_ext
+ (
+ String ext,
+ List(MIME) l
+ ) =
+ if l is
+ {
+ [ ] then success("application/octet-stream"), // failure,
+ [h . t] then if h is mime(mime_type,extension) then
+ if ext = extension
+ then success(mime_type)
+ else recognize_mime_type_from_ext(ext,t)
+ }.
+
+define Maybe(String)
+ recognize_mime_type_from_uri
+ (
+ Web_Site_Description desc,
+ String uri
+ ) =
+ recognize_mime_type_from_ext(get_uri_extension(uri),known_mime_types(desc)).
+
+
+
+
+
+
+
+
+ *** [5.4] Formating HTTP headers.
+
+ This is the formating for sending to the client (hence, it has nothing to do with the
+ component 'journal_headers' in the web site description).
+
+define Printable_tree
+ format_headers
+ (
+ List(HTTP_header) headers
+ ) =
+ if headers is
+ {
+ [ ] then [ ],
+ [h . t] then if h is http_header(name,value) then
+ [name,": ",value,crlf . format_headers(t)]
+ }.
+
+
+
+
+
+
+ *** [5.5] Sending a file.
+
+ We send 2 headers 'Content-Type' and 'Content-Length'.
+
+define List(HTTP_header)
+ headers_for_send_file
+ (
+ String mime_type,
+ Int32 size,
+ ) =
+ [
+ http_header("Content-Type",mime_type),
+ http_header("Content-Length",integer_to_string(size)),
+ ].
+
+
+
+ Sending the body of the answer (i.e. the file itself).
+
+define One
+ send_file_body
+ (
+ Web_Site_Description desc,
+ Connection connection, // connection with the client
+ Connection file, // file to be sent already opened
+ Int32 size, // size of file
+ Int32 sent, // bytes already sent
+ String filename // name of file
+ ) =
+ if sent >= size then unique else
+ if read(file,min(10000,size-sent),60) is
+ {
+ error then log_journal_msg(desc,"Cannot read from file '"+filename+"'.\n"),
+ timeout then log_journal_msg(desc,"Cannot read from file timeoput'"+filename+"'.\n"),
+ ok(ba) then
+ with nr = length(ba), // get the number of bytes read
+ if reliable_write(connection,ba) is
+ {
+ failure then log_journal_msg(desc,"Cannot write into connection.\n"),
+ success(nw) then
+ send_file_body(desc,connection,file,size,sent+nw,filename)
+ }
+ }.
+
+
+
+
+ Sending the answer line, the headers and the body.
+
+define One
+ send_file
+ (
+ Web_Site_Description desc,
+ Connection connection,
+ List(HTTP_header) headers,
+ Int32 size,
+ Connection file,
+ String filename,
+ One -> One action_before_send_file
+ ) =
+ action_before_send_file(unique);
+ forget(reliable_write(connection,to_byte_array("HTTP/1.1 200 OK"+crlf)));
+ forget(reliable_write(connection,[format_headers(headers) , crlf]));
+ send_file_body(desc,connection,file,size,0,filename).
+
+
+
+ Checking if a connection is under SSL.
+
+define Bool
+ is_SSL
+ (
+ Connection c
+ ) =
+ if c is
+ {
+ file_r(_) then false,
+ file_w(_) then false,
+ file_rw(_) then false,
+ tcp(_) then false,
+ ssl(_) then true
+ }.
+
+
+
+ Before opening and sending a file, we check the MIME type. It must be recognized,
+ except if there is a valid authorization for private download.
+
+define One
+ send_file
+ (
+ Web_Site_Description desc,
+ Connection connection,
+ String uri,
+ Maybe(String) mbauthorization,
+ One -> One action_before_send_file
+ ) =
+ if mbauthorization is
+ {
+ //--- file without authorization: take it from public ---
+ failure then if recognize_mime_type_from_uri(desc,uri) is
+ {
+ failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"),
+ success(mime_type) then
+ with path = site_directory(desc)+"/public"+uri,
+ if (Maybe(RStream))connect to file path is
+ {
+ failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"),
+ success(f) then with size = file_size(f),
+ send_file(desc,
+ connection,
+ headers_for_send_file(mime_type,size),
+ size,
+ file(f),
+ uri,
+ action_before_send_file)
+ }
+ },
+
+ //--- file with authorization: apply 'private download' mecanism ---
+ success(authorization) then
+ with private_download_dir = site_directory(desc)+"/private_download",
+ if (RetrieveResult(String))retrieve(private_download_dir+"/z"+authorization)
+ is ok(absolute_path)
+ then (
+ with new_hash = compute_authorization(authorization_secret(desc),
+ absolute_path),
+ if (Maybe(RStream))connect to file absolute_path is
+ {
+ failure then log_journal_msg(desc,"Cannot find file '"+absolute_path+"'.\n"),
+ success(f) then with size = file_size(f),
+ send_file(desc,
+ connection,
+ headers_for_send_file(if recognize_mime_type_from_uri(desc,uri) is
+ {
+ failure then "application/octet-stream"
+ success(mime_type) then mime_type
+ },
+ size),
+ size,
+ file(f),
+ uri,
+ action_before_send_file)
+ }
+ )
+ else log_journal_msg(desc,"Cannot find or read authorization file.\n")
+ }.
+
+
+ define One
+ send_file
+ (
+ Web_Site_Description desc,
+ Connection connection,
+ String uri,
+ Maybe(String) mbauthorization,
+ One -> One action_before_send_file
+ ) =
+ if mbauthorization is
+ {
+ //--- file without authorization: take it from public ---
+ failure then if recognize_mime_type_from_uri(desc,uri) is
+ {
+ failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"),
+ success(mime_type) then
+ with path = site_directory(desc)+"/public"+uri,
+ if (Maybe(RStream))connect to file path is
+ {
+ failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"),
+ success(f) then with size = file_size(f),
+ send_file(desc,
+ connection,
+ headers_for_send_file(mime_type,size),
+ size,
+ file(f),
+ uri,
+ action_before_send_file)
+ }
+ },
+
+ //--- file with authorization: apply 'private download' mecanism ---
+ success(authorization) then
+ if is_SSL(connection)
+ then (
+ with private_download_dir = site_directory(desc)+"/private_download",
+ if (RetrieveResult(String))retrieve(private_download_dir+"/z"+authorization)
+ is ok(absolute_path)
+ then (
+ with new_hash = compute_authorization(authorization_secret(desc),
+ absolute_path),
+ if (Maybe(RStream))connect to file absolute_path is
+ {
+ failure then log_journal_msg(desc,"Cannot find file '"+absolute_path+"'.\n"),
+ success(f) then with size = file_size(f),
+ send_file(desc,
+ connection,
+ headers_for_send_file(if recognize_mime_type_from_uri(desc,uri) is
+ {
+ failure then "application/octet-stream"
+ success(mime_type) then mime_type
+ },
+ size),
+ size,
+ file(f),
+ uri,
+ action_before_send_file)
+ }
+ )
+ else log_journal_msg(desc,"Cannot find or read authorization file.\n")
+ )
+ else //-- file with authorization, but under HTTP: take it from private_download
+ if recognize_mime_type_from_uri(desc,uri) is
+ {
+ failure then log_journal_msg(desc,"No MIME type found for '"+uri+"'.\n"),
+ success(mime_type) then
+ with path = site_directory(desc)+"/private_download"+uri,
+ if (Maybe(RStream))connect to file path is
+ {
+ failure then log_journal_msg(desc,"Cannot find file '"+path+"'.\n"),
+ success(f) then with size = file_size(f),
+ send_file(desc,
+ connection,
+ headers_for_send_file(mime_type,size),
+ size,
+ file(f),
+ uri,
+ action_before_send_file)
+ }
+ }
+ }.
+
+
+
+
+
+
+
+ *** [5.6] Answering a www-url encoded request.
+
+ Standard headers are for answering ".awp" requests.
+
+define List(HTTP_header)
+ standard_headers
+ (
+ Int32 answer_body_size,
+ String charset
+ ) =
+ [
+ //http_header("Content-Type","text/html"),
+ http_header("Content-Type","text/html; charset="+charset),
+ http_header("Content-length",integer_to_string(answer_body_size))
+ ].
+
+
+define One
+ www_url_answer
+ (
+ String host_name,
+ Web_Site_Description desc,
+ Connection connection, // with the client
+ Int32 ip_addr, // of the client
+ HTTP_RequestLine request_line,
+ List(HTTP_header) headers,
+ ByteArray body,
+ One -> String generate_tt // trust ticket generation
+ ) =
+ with all_web_args = query_string(request_line) +
+ read_www_url_encoded_web_args(to_string(body),0),
+ uri = uri(request_line),
+ ext = get_uri_extension(uri),
+ (if member(journal_extensions(desc),ext)
+ then log_journal_msg(desc,
+ format_request(desc,connection,request_line,headers,all_web_args))
+ else unique);
+ if is_illegal_uri(uri,0)
+ then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
+ else (if (ext = ".awp" | ext = "")
+ then (with answer_headers_body = awp_handler(desc)(host_name,
+ http_info(ip_addr,uri,headers,generate_tt),
+ all_web_args,
+ is_SSL(connection)),
+ if answer_headers_body is (additional_headers,answer_body) then
+ forget(reliable_write(connection,
+ [ "HTTP/1.1 200 OK", crlf,
+ format_headers(standard_headers(length(answer_body),charset(desc))),
+ format_headers(additional_headers),
+ crlf .
+ answer_body])))
+ else (send_file(desc,
+ connection,
+ uri,
+ if web_arg_value(all_web_args,"zauth") is
+ {
+ not_found then failure,
+ found(v) then success(v)
+ },
+ (One u) |-> before_send_file(desc)(all_web_args)))).
+
+
+
+
+
+
+
+ *** [5.7] Answering a multipart/form-data encoded request.
+
+ In order to support upload of files, we must be able to read web arguments which are
+ encoded in a multipart/form-data body. The first thing to do is to find the
+ boundary. The boundary is a special string which delimits the various parts of the
+ 'multipart' body. It is found within the value of the 'Content-Type' HTTP header, as
+ the value of the 'boundary' attribute.
+
+
+
+
+
+ *** [5.7.1] Finding the boundary.
+
+ Hence, we just have to find the string 'boundary=' within the value of the
+ 'Content-Type' header, and read the value of the boundary from there.
+
+define Bool
+ delimits_boundary
+ (
+ Word8 c
+ ) =
+ if c = ' ' then true else
+ if c = 13 then true else
+ if c = 10 then true else
+ if c = 0 then true else
+ if c = ',' then true else
+ c = ';'.
+
+
+define Maybe(String)
+ get_boundary_value_3
+ (
+ String s,
+ Int32 i,
+ List(Word8) so_far
+ ) =
+ if nth(i,s) is
+ {
+ failure then success(implode(reverse(so_far))),
+ success(c) then
+ if delimits_boundary(c)
+ then success(implode(reverse(so_far)))
+ else get_boundary_value_3(s,i+1,[c . so_far])
+ }.
+
+
+
+define Maybe(String)
+ get_boundary_value_2
+ (
+ String s,
+ Int32 i,
+ ) =
+ if nth(i,s) is
+ {
+ failure then failure,
+ success(c) then
+ if is_blank(c)
+ then get_boundary_value_2(s,i+1)
+ else get_boundary_value_3(s,i+1,[c])
+ }.
+
+define Maybe(String)
+ get_boundary_value_1
+ (
+ String s, // string into which we must find '= ...'
+ Int32 i // position of start of search
+ ) =
+ if nth(i,s) is
+ {
+ failure then failure,
+ success(c) then
+ if is_blank(c)
+ then get_boundary_value_1(s,i+1)
+ else if c = '='
+ then get_boundary_value_2(s,i+1)
+ else failure
+ }.
+
+
+define Maybe(String)
+ get_boundary
+ (
+ String content_type_header_value
+ ) =
+ if find("boundary",content_type_header_value,0) is
+ {
+ failure then failure,
+ success(n) then // 'boundary' has been found at position n
+ get_boundary_value_1(content_type_header_value,n+8)
+ }.
+
+define Maybe(String)
+ get_boundary
+ (
+ List(HTTP_header) headers
+ ) =
+ if headers is
+ {
+ [ ] then failure,
+ [h . t] then if h is http_header(name,value) then
+ if name = "content-type"
+ then get_boundary(value)
+ else get_boundary(t)
+ }.
+
+
+
+
+
+
+
+
+ *** [5.7.2] Reading attributes from a multipart entity.
+
+ Entities in a multipart/form-data body are separated by instances of the string:
+
+ --bbbbb
+
+ where bbbbb is the boundary computed above. Actually, the body has the form:
+
+ --bbbbb
+
+ --bbbbb
+
+ --bbbbb
+ ...
+ --bbbbb
+
+ --bbbbb
+
+
+ We have to extract an entity which is in the body between offsets 'start' and 'end'
+ (computed when boundaries have been localized). The entity itself is made of two parts:
+ headers and body. The body is separated from the headers by a blank line. This blank
+ line (a double crlf) marks the beginning of the body of the entity. Within the headers
+ of the entity, we look for a 'Content-Disposition' header, which should look like this:
+
+ Content-Disposition: form-data; name="..."; filename="..." crlf
+
+ We are just interested in the name and the file name. Hence we first search
+ 'Content-Disposition', then we search 'name' and read the value, and we do the same for
+ 'filename'.
+
+ If the 'filename' attribute is not present, the web arg is an ordinary one, otherwise,
+ it is an uploaded file.
+
+
+ Below is a variant of 'find' (see 'tools/findstring.anubis'), with an extra 'end'
+ argument.
+
+define Maybe(Int32)
+ find
+ (
+ String what,
+ ByteArray where,
+ Int32 start,
+ Int32 end
+ ) =
+ if find(to_byte_array(what),where,start) is
+ {
+ failure then failure,
+ success(n) then
+ if n+length(what) >= end
+ then failure
+ else success(n)
+ }.
+
+
+define String
+ read_attribute_value
+ (
+ ByteArray where,
+ Int32 start,
+ Int32 end,
+ List(Word8) so_far
+ ) =
+ if start >= end then implode(reverse(so_far)) else
+ if nth(start,where) is
+ {
+ failure then implode(reverse(so_far)),
+ success(c) then
+ if c = '\"'
+ then implode(reverse(so_far))
+ else read_attribute_value(where,start+1,end,[c . so_far])
+ }.
+
+define Maybe(String)
+ find_attribute
+ (
+ String name,
+ ByteArray where,
+ Int32 start,
+ Int32 end
+ ) =
+ with name = name+"=\"",
+ if find(to_byte_array(name),where,start) is
+ {
+ failure then failure,
+ success(n) then
+ if n+length(name) >= end
+ then failure
+ else success(read_attribute_value(where,n+length(name),end,[]))
+ }.
+
+
+
+define Maybe((String,Maybe(String)))
+ find_name_and_filename
+ (
+ ByteArray body,
+ Int32 start,
+ Int32 end
+ ) =
+ if find(to_byte_array("Content-Disposition"),body,start) is
+ {
+ failure then failure,
+ success(n) then
+ if find_attribute("name",body,n+19,end) is
+ {
+ failure then failure,
+ success(name_value) then if find_attribute("filename",body,n+19,end) is
+ {
+ failure then success((name_value,failure)),
+ success(filename_value) then success((name_value,success(filename_value)))
+ }
+ }
+ }.
+
+
+
+
+
+
+
+
+
+
+ *** [5.7.3] Creating a temporary filename for an uploaded file.
+
+variable Int32 uploaded_file_count = 0.
+
+ This variable is local to the virtual machine. Hence, its value is 0 each time a new
+ requests arrives. Temporary uploaded files are stored in the directory represented by
+ 'upload_temporary_directory'. The filenames have the form:
+
+ _m_n
+
+ where 'm' is the number of the virtual machine, and 'n' a number obtained by
+ incrementing 'uploaded_file_count'. Notice that the program must do something with this
+ file (move it to some directory/name), otherwise, it will probably be overwritten the
+ next time the same machine works.
+
+
+
+
+
+
+ *** [5.7.4] Saving an uploaded file under a temporary filename.
+
+define Maybe(String) // returns the temporary file name
+ save_uploaded_file
+ (
+ Web_Site_Description desc,
+ ByteArray body,
+ Int32 start,
+ Int32 end
+ ) =
+ uploaded_file_count <- 1 + *uploaded_file_count;
+ with tfn = "_"+integer_to_string(virtual_machine_id)+"_"+integer_to_string(*uploaded_file_count),
+ if (Maybe(WStream))connect to file site_directory(desc)+"/upload_temporary/"+tfn is
+ {
+ failure then failure,
+ success(f) then
+ if reliable_write(file(f),extract(body,start,end)) is
+ {
+ failure then failure,
+ success(nw) then
+ if nw = end - start
+ then success(tfn)
+ else failure
+ }
+ }.
+
+
+
+
+
+
+
+
+ *** [5.7.5] Removing the path from a file name.
+
+ When a file is uploaded, the browser sends the complete path of the file on the client
+ machine as the file name. Actually, this is not quite normal. Nevertheless, we need to
+ remove the path, and keep only the file name. This is achieved by 'remove_path' below.
+
+define Int32
+ file_name_begin
+ (
+ String full_name,
+ Int32 i
+ ) =
+ if nth(i,full_name) is
+ {
+ failure then 0,
+ success(c) then
+ if c = '/' then i+1 else
+ if c = '\\' then i+1 else
+ file_name_begin(full_name,i-1)
+ }.
+
+define String
+ remove_path
+ (
+ String full_name
+ ) =
+ with l = length(full_name),
+ b = file_name_begin(full_name,l-1),
+ substr(full_name,b,l-b).
+
+
+
+
+
+ *** [5.7.6] Reading a multipart entity.
+
+define Maybe(Web_arg)
+ get_multipart_entity
+ (
+ Web_Site_Description desc,
+ ByteArray body,
+ Int32 start,
+ Int32 end
+ ) =
+ if find(to_byte_array(crlf+crlf),body,start) is
+ {
+ failure then failure,
+ success(k) then
+ if k >= end // must be within this entity, not the next one
+ then failure
+ else if find_name_and_filename(body,start,k) is
+ {
+ failure then failure,
+ success(n_mbfn) then if n_mbfn is (name,mbfn) then
+ if mbfn is
+ {
+ failure then
+ success(web_arg(name,to_string(extract(body,k+4,end-2)))),
+ // we must substract 2 to end because of crlf just before the boundary
+
+ success(fn) then
+ if save_uploaded_file(desc,body,k+4,end-2) is
+ {
+ failure then failure,
+ success(tfn) then
+ success(upload(name,remove_path(fn),
+ site_directory(desc)+"/upload_temporary/"+tfn))
+
+ }
+ }
+ }
+ }.
+
+
+
+define List(Web_arg)
+ read_multipart_form_data_encoded_web_args
+ (
+ Web_Site_Description desc,
+ ByteArray body,
+ ByteArray __boundary,
+ Int32 i,
+ ) =
+ if find(__boundary,body,i) is
+ {
+ failure then [ ],
+ success(n) then
+ if find(__boundary,body,n+length(__boundary)) is
+ {
+ failure then [ ],
+ success(m) then
+ if get_multipart_entity(desc,body,n+length(__boundary),m) is
+ {
+ failure then [ ],
+ success(wa) then
+ [wa . read_multipart_form_data_encoded_web_args(desc,body,__boundary,m)]
+ }
+ }
+ }.
+
+
+
+define One
+ multipart_form_data_answer
+ (
+ String host_name,
+ Web_Site_Description desc,
+ Connection connection,
+ Int32 ip_addr,
+ HTTP_RequestLine request_line,
+ List(HTTP_header) headers,
+ ByteArray body,
+ One -> String generate_tt
+ ) =
+ if get_boundary(headers) is
+ {
+ failure then unique,
+ success(boundary) then
+ with all_web_args = query_string(request_line) +
+ read_multipart_form_data_encoded_web_args(desc,
+ body,
+ to_byte_array("--"+boundary),
+ 0),
+ uri = uri(request_line),
+ ext = get_uri_extension(uri),
+ log_journal_msg(desc,
+ format_request(desc,connection,request_line,headers,all_web_args));
+ if is_illegal_uri(uri,0)
+ then log_journal_msg(desc,"Received illegal URI: "+uri+"\n")
+ else
+ if (ext = ".awp" | ext = "") then
+ (with answer_headers_body = awp_handler(desc)(host_name,
+ http_info(ip_addr,uri,headers,generate_tt),
+ all_web_args,
+ is_SSL(connection)),
+ if answer_headers_body is (additional_headers,answer_body) then
+ forget(reliable_write(connection,
+ [ "HTTP/1.1 200 OK",crlf,
+ format_headers(standard_headers(length(answer_body),charset(desc))),
+ format_headers(additional_headers),
+ crlf .
+ answer_body])))
+ else unique
+ }.
+
+
+
+
+
+
+
+
+ *** [5.8] Handling redirections.
+
+ 'redirections' (of type 'List(Redirection)') contains redirection directives. Each one
+ has the form:
+
+ redirect(required_uri,required_host,corresponding_uri).
+
+ The host required by the client may be found in the 'Host' HTTP header. The URI
+ required by the client is given below as 'uri'. We just have to find the required host
+ in the headers, and to find the corresponding redirection directive.
+
+
+ In the next fonction, the required host and URI are known. We just have to search in
+ the 'redirections' list.
+
+define String
+ handle_redirection
+ (
+ String required_uri,
+ String required_host,
+ List(Redirection) redirections
+ ) =
+ if redirections is
+ {
+ [ ] then required_uri,
+ [h . t] then if h is redirect(uri,host,target) then
+ if host = required_host
+ then if uri = required_uri
+ then target
+ else handle_redirection(required_uri,required_host,t)
+ else handle_redirection(required_uri,required_host,t)
+ }.
+
+
+
+ The host name may be encumbered by a port number, like
+
+ www.our-business.com:1607
+
+ We must remove this port number, otherwise the host name may not be recognized.
+
+define String
+ strip_port
+ (
+ String name,
+ Int32 i
+ ) =
+ if nth(i,name) is
+ {
+ failure then name,
+ success(c) then
+ if c = ':'
+ then substr(name,0,i)
+ else strip_port(name,i+1)
+ }.
+
+
+
+
+
+ Finding the 'Host' header. No redirection is performed if this header is not found.
+
+define String
+ handle_redirection // returns the redirected URI
+ (
+ List(Redirection) redirections,
+ String uri, // original URI
+ List(HTTP_header) headers
+ ) =
+ if headers is
+ {
+ [ ] then uri,
+ [h . t] then if h is http_header(name,value) then
+ if name = "host"
+ then handle_redirection(uri,strip_port(value,0),redirections)
+ else handle_redirection(redirections,uri,t)
+ }.
+
+
+
+
+
+
+
+
+ *** [5.9] Answering both sorts of requests.
+
+ We must decide if the request is www-url encoded or multipart/form-data encoded. This
+ is achieved through the header 'Content-Type'.
+
+define EncodingType
+ get_encoding_type
+ (
+ List(HTTP_header) headers
+ ) =
+ if headers is
+ {
+ [ ] then www_url, // this is the default
+ [h . t] then if h is http_header(name,value) then
+ if name = "content-type"
+ then if find("multipart/form-data",value,0) is
+ {
+ failure then www_url,
+ success(_) then multipart_form_data
+ }
+ else get_encoding_type(t)
+ }.
+
+
+
+define One
+ send_answer
+ (
+ String host_name,
+ Web_Site_Description desc,
+ Connection connection,
+ HTTP_RequestLine rqline,
+ List(HTTP_header) headers,
+ ByteArray body,
+ One -> String generate_tt
+ ) =
+ if rqline is request_line(type,uri,qstring) then
+ with rqline = request_line(type,handle_redirection(redirections(desc),uri,headers),qstring),
+ if remote_IP_address_and_port(connection) is (ip_addr,_) then
+ if get_encoding_type(headers) is
+ {
+ www_url then
+ www_url_answer(host_name,desc,connection,ip_addr,rqline,headers,body,generate_tt),
+ multipart_form_data then
+ multipart_form_data_answer(host_name,desc,connection,ip_addr,rqline,headers,body,generate_tt)
+ }.
+
+
+
+
+
+
+
+ *** [6] The HTTP/HTTPS server.
+
+ The command 'start_server' (declared in 'predefined.anubis') starts a virtual machine
+ which opens a server TCP/IP connection, and which continuously listens to this
+ connection. When a request arrives, this machine delegates the work of deciphering and
+ answering the request to another virtual machine, and continues to listen. The job of
+ the delegated machine is defined by the HTTP request handler below.
+
+
+
+
+
+ *** [6.1] Determining the requested host.
+
+ When a request arrives to one of our two servers, we must decide which site (host) is
+ requested.
+
+define Maybe(String)
+ get_host_header_value
+ (
+ List(HTTP_header) headers
+ ) =
+ if headers is
+ {
+ [ ] then failure,
+ [h . t] then if h is http_header(name,value) then
+ if name = "host"
+ then success(strip_port(value,0))
+ else get_host_header_value(t)
+ }.
+
+define Maybe((String,Web_Site_Description))
+ get_site
+ (
+ String requested_host,
+ List(Web_Site_Description) sites
+ ) =
+ if sites is
+ {
+ [ ] then print("Requested host '"+requested_host+"' does not exist.\n"); failure,
+ [site1 . others] then
+ if site1 is web_site_description(common_names,_,_,_,_,_,_,_,_,_) then
+ if member(common_names,requested_host)
+ then success((requested_host,site1))
+ else get_site(requested_host,others)
+ }.
+
+
+define Maybe((String,Web_Site_Description))
+ get_site
+ (
+ List(HTTP_header) headers,
+ List(Web_Site_Description) sites
+ ) =
+ if get_host_header_value(headers) is
+ {
+ failure then print("No 'Host' HTTP header.\n"); failure,
+ success(requested_host) then
+ //here we treat the case with only one site. hence we accept any host request
+ //print("*** there is " +length(sites) + " sites \n");
+ if length(sites) = 1 then
+ with site = force_nth(0, sites),
+ //print("ONE server OK\n");
+ success((requested_host, site))
+ else
+ get_site(requested_host,sites)
+ }.
+
+
+
+
+
+ *** [6.2] The HTTP request handler.
+
+ Here is the HTTP/HTTPS handler. It is called at each new request in a separate virtual
+ machine. It reads the headers of the HTTP request, determines the host, determines body
+ size, reads the body of the HTTP request, and answers the request.
+
+
+
+define One -> String make_generate_trust_ticket(DenialOfService dos).
+
+
+define One
+ http_https_handler
+ (
+ List(Web_Site_Description) sites,
+ Connection connection,
+ Bool is_https,
+ DenialOfService dos
+ ) =
+ with start_time = (Int32)now,
+ sttm <- start_time;
+ if dos is denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
+ if remote_IP_address_and_port(connection) is (ip_addr,port) then
+ if read_request_line(connection,start_time+*rld_v,dos) is
+ {
+ error(msg) then print(format(msg)),
+ ok(request_line) then
+ if read_http_headers(connection,start_time+*hd_v,dos) is
+ {
+ error(msg) then print(format(msg)),
+ ok(headers) then if get_site(headers,sites) is
+ {
+ failure then unique,
+ success(p) then if p is (host_name,desc) then
+ if get_body_size(headers) is
+ {
+ error(msg) then log_journal_msg(desc,format(msg)),
+ ok(body_size) then
+ if read_http_body(connection,body_size,constant_byte_array(0,0),1000) is
+ {
+ error(msg) then log_journal_msg(desc,format(msg)),
+ ok(body) then
+ send_answer(host_name,desc,connection,request_line,headers,body,
+ make_generate_trust_ticket(dos))
+ }
+ }
+ }
+ }
+ }.
+
+
+ Below are the two tools for constructing the handlers required by 'start_server' and
+ 'start_ssl_server' (see 'predefined.anubis').
+
+define Bool is_dubious_IP(Int32 ip, DenialOfService dos).
+
+define Server -> ((RWStream) -> One)
+ make_http_handler
+ (
+ List(Web_Site_Description) sites,
+ DenialOfService dos
+ ) =
+ (Server server) |-> (RWStream connection) |->
+ if remote_IP_address_and_port(connection) is (addr,_) then
+ if is_dubious_IP(addr,dos)
+ then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
+ else http_https_handler(sites,tcp(connection),false,dos).
+
+define Server -> (SSL_Connection -> One)
+ make_https_handler
+ (
+ List(Web_Site_Description) sites,
+ DenialOfService dos
+ ) =
+ (Server server) |-> (SSL_Connection connection) |->
+ http_https_handler(sites,ssl(connection),true,dos).
+
+
+
+
+ *** [6.3] Server's tasks.
+
+ Some tasks must be executed periodically, for example for cleaning up directories from
+ short life time files.
+
+ The next function removes from the given directory (and recursively from its
+ subdirectories) all the files which are more than 10 minutes old.
+
+define One
+ cleanup_directory_10mn
+ (
+ String dir // path of private download directory (or subdirectory) with trailing slash
+ ) =
+ forget(map((FileDescription fd) |-> if fd is
+ {
+ no_info(name) then forget(remove(dir+name)),
+ file(name,_,_,d) then if d+600 < now then forget(remove(dir+name)) else unique,
+ link(name,_,_,d) then if d+600 < now then forget(remove(dir+name)) else unique,
+ directory(name,_,_) then cleanup_directory_10mn(dir+name+"/"),
+ },
+ directory_full_list(dir,"*","*","*"))).
+
+
+define One
+ http_servers_tasks
+ (
+ List(Web_Site_Description) sites,
+ List(Server) servers,
+ Int32 period,
+ Int32 next_time,
+ ) =
+ if mapand(is_down,servers)
+ then unique
+ else if now > next_time
+ then
+ (
+ /*
+ forget(map((Web_Site_Description wsd) |->
+ cleanup_directory_10mn(site_directory(wsd)+"/private_download/"),
+ sites));
+ */
+ http_servers_tasks(sites,servers,period,next_time+period)
+ )
+ else
+ (
+ sleep(1000);
+ http_servers_tasks(sites,servers,period,next_time)
+ ).
+
+
+public define One
+ start_http_servers_tasks
+ (
+ List(Web_Site_Description) sites,
+ List(Server) servers,
+ Int32 period
+ ) =
+ delegate http_servers_tasks(sites,servers,period,now),
+ unique.
+
+
+
+
+ *** [6.4] Protection against 'denial of service' attacks.
+
+
+ *** [6.4.1] Counting connections.
+
+define Bool // returns false if the counter cannot be incremented (too many connections)
+ increment_connections_counter
+ (
+ Var(Int32) counter
+ ) =
+ protect with n = *counter,
+ if n >= 100
+ then false
+ else (counter <- (*counter)+1); true.
+
+define One
+ decrement_connections_counter
+ (
+ Var(Int32) counter
+ ) =
+ protect counter <- (*counter)-1.
+
+
+
+
+
+ *** [6.4.2] Recording dubious IP addresses.
+
+
+define List(DubiousIP)
+ record_dubious_IP
+ (
+ Int32 ip,
+ List(DubiousIP) l
+ ) =
+ if l is
+ {
+ [ ] then [dubious_ip(ip,now)],
+ [h . t] then if h is dubious_ip(addr,time) then
+ if addr = ip
+ then [dubious_ip(addr,now) . t]
+ else [h . record_dubious_IP(ip,t)]
+ }.
+
+
+define One
+ record_dubious_IP
+ (
+ Int32 dubious_IP,
+ Var(List(DubiousIP)) v
+ ) =
+ protect v <- record_dubious_IP(dubious_IP,*v).
+
+
+define One
+ record_dubious_IP
+ (
+ Int32 addr,
+ DenialOfService dos
+ ) =
+ record_dubious_IP(addr,list_of_dubious(dos)).
+
+
+public define DenialOfService
+ load_denial_of_service_info
+ =
+ if (RetrieveResult(DenialOfService))retrieve(my_anubis_directory+"/web_sites/dos_info") is
+ ok(dos) then dos else denial_of_service(
+ var(100),
+ var(1000),
+ var(1500),
+ var(2000),
+ var([]),
+ var([])).
+
+
+
+
+ *** [6.4.3] Testing if an address is dubious.
+
+define Bool
+ is_dubious_IP
+ (
+ Int32 ip,
+ List(DubiousIP) l
+ ) =
+ if l is
+ {
+ [ ] then false,
+ [h . t] then if h is dubious_ip(addr,time) then
+ if ip = addr
+ then true
+ else is_dubious_IP(ip,t)
+ }.
+
+
+define Bool
+ is_dubious_IP
+ (
+ Int32 ip,
+ DenialOfService dos
+ ) =
+ if dos is
+ {
+ denial_of_service(mc_v,rld_v,hd_v,ad_v,ld_v,ra_v) then
+ if member(*ra_v,ip) then false else
+ is_dubious_IP(ip,*ld_v)
+ }.
+
+
+
+
+ *** [6.4.4] Removing inactive dubious IP addresses.
+
+define List(DubiousIP)
+ remove_inactive_dubious_IP
+ (
+ List(DubiousIP) l,
+ Int32 ref_time,
+ ) =
+ if l is
+ {
+ [ ] then [ ],
+ [h . t] then if h is dubious_ip(addr,time) then
+ if time < ref_time
+ then (print(ip_addr_to_string(addr)+" removed from dubious addresses list.\n");
+ remove_inactive_dubious_IP(t,ref_time))
+ else [h . remove_inactive_dubious_IP(t,ref_time)]
+ }.
+
+define One
+ remove_inactive_dubious_IP
+ (
+ Var(List(DubiousIP)) v
+ ) =
+ protect
+ with ref_time = now - 600, // 10 minutes
+ v <- remove_inactive_dubious_IP(*v,ref_time).
+
+
+ The above function will be executed periodically by the servers's tasks machine.
+
+
+
+ *** [6.4.5] Making the function for generating trust tickets.
+
+define One -> String
+ make_generate_trust_ticket
+ (
+ DenialOfService dos
+ ) =
+ (One _) |-> "".
+
+
+
+
+
+
+
+ *** [6.5] Starting the HTTP/HTTPS server.
+
+
+ The next function creates the directories for all sites (if they don't already exist).
+
+define One
+ create_directories
+ (
+ List(Web_Site_Description) sites
+ ) =
+ if sites is
+ {
+ [ ] then unique,
+ [s1 . others] then
+ with site_dir = site_directory(s1),
+ forget(make_directory(site_dir+"/public",default_directory_mode));
+ forget(make_directory(site_dir+"/upload_temporary",default_directory_mode));
+ forget(make_directory(site_dir+"/private_download",default_directory_mode));
+ forget(make_directory(site_dir+"/journal",default_directory_mode));
+ create_directories(others)
+ }.
+
+
+
+
+
+ Below are the commands for starting an HTTP server and an HTTPS server.
+
+
+define StartServerResult
+ start_http_server
+ (
+ Int32 ip_address,
+ Int32 port,
+ Server -> ((RWStream) -> One) handler,
+ Int32 retries,
+ DenialOfService dos
+ ) =
+ if start_server(ip_address,
+ port,
+ handler,
+ identity) is ok(server)
+ then print(" \r");
+ ok(server)
+ else print("Port "+port+": retry number "+retries+"\r");
+ sleep(1000);
+ start_http_server(ip_address,port,handler,retries+1,dos).
+
+public define StartServerResult
+ start_http_server
+ (
+ Int32 ip_address,
+ Int32 port,
+ List(Web_Site_Description) sites,
+ DenialOfService dos
+ ) =
+ create_directories(sites);
+ start_http_server(ip_address,port,
+ make_http_handler(sites,dos),
+ 0,
+ dos).
+
+
+ For the HTTPS server, we have a problem which is due to the fact that 'anbexec' is not
+ yet able to manipulate several SSL server certificates. 'anbexec' and
+ 'predefined.anubis' must be changed. Sorry ! This will be done as soon as possible. The
+ 'solution' for the time being is to provide the common name of the unique SSL server
+ certificate.
+
+
+define StartServerResult
+ start_https_server
+ (
+ Int32 ip_address,
+ Int32 port,
+ String certificate_common_name,
+ Server -> (SSL_Connection -> One) handler,
+ Int32 retries,
+ DenialOfService dos
+ ) =
+ if start_ssl_server(ip_address,
+ port,
+ certificate_common_name,
+ handler,
+ identity) is ok(server)
+ then print(" \r");
+ ok(server)
+ else print("Port "+port+": retry number "+retries+"\r");
+ sleep(1000);
+ start_https_server(ip_address,port,
+ certificate_common_name,
+ handler,retries+1,
+ dos).
+
+
+public define StartServerResult
+ start_https_server
+ (
+ Int32 ip_address,
+ Int32 port,
+ String certificate_common_name, // of SSL server certificate
+ List(Web_Site_Description) sites,
+ DenialOfService dos
+ ) =
+ create_directories(sites);
+ start_https_server(ip_address,port,certificate_common_name,
+ make_https_handler(sites,dos),
+ 0,dos).
+
+
+
+
+
+
+
+
+
+ *** [7] The web dispatcher.
+
+
+ *** [7.1] The dispatcher server.
+
+define One
+ send_dispatching_page
+ (
+ RWStream conn,
+ String common_name,
+ Int32 port
+ ) =
+ print("Dispatching '"+common_name+"' to port "+port+"\n");
+ forget(reliable_write(conn,to_byte_array(
+ ""
+ ))).
+
+
+
+define Maybe(DispatcherInfo)
+ find_host
+ (
+ List(DispatcherInfo) l,
+ String host
+ ) =
+ if l is
+ {
+ [ ] then failure,
+ [h . t] then if h is site(name,port) then
+ if name = host
+ then success(h)
+ else find_host(t,host)
+ }.
+
+
+
+define Server -> ((RWStream) -> One)
+ make_dispatcher_handler
+ (
+ Var(List(DispatcherInfo)) info_v,
+ DenialOfService dos
+ ) =
+ (Server server) |-> (RWStream conn) |->
+ with start_time = (Int32)now,
+ if read_request_line(tcp(conn),start_time+*request_line_delay(dos),dos) is
+ {
+ error(msg) then print(format(msg)),
+ ok(request_line) then
+ if read_http_headers(tcp(conn),start_time+*headers_delay(dos),dos) is
+ {
+ error(msg) then print(format(msg)),
+ ok(headers) then if get_host_header_value(headers) is
+ {
+ failure then print("No 'HOST' HTTP header.\n"),
+ success(host) then
+ if find_host(*info_v,host) is
+ {
+ failure then print("Host: '"+host+"' not registered.\n"),
+ success(s) then if s is site(common_name,ip_port) then
+ send_dispatching_page(conn,common_name,ip_port)
+ }
+ }
+ }
+ }.
+
+
+define One
+ dispatcher_update_error
+ (
+ String file_path
+ ) =
+ print("web_dispatcher: unable to reread file: '"+file_path+"'.\n").
+
+
+define Bool
+ dispatcher_update_data
+ (
+ String info_file_path,
+ Var(List(DispatcherInfo)) info_v,
+ Var(Int32) info_date_v
+ ) =
+ if directory_full_list(my_anubis_directory+"/web_sites","dispatcher.info","","") is
+ {
+ [ ] then false,
+ [h . t] then if h is
+ {
+ no_info(n) then false,
+ file(n,_,_,d) then if n = "dispatcher.info"
+ then (info_date_v <- d;
+ if (RetrieveResult(List(DispatcherInfo)))retrieve(info_file_path) is
+ {
+ cannot_find_file then false,
+ read_error then false,
+ type_error then false,
+ ok(info) then info_v <- info; true
+ })
+ else false,
+ link(_,_,_,_) then false,
+ directory(_,_,_) then false
+ }
+ }.
+
+
+
+ The loop within which the dispatcher updates its data every 3 seconds:
+
+define One
+ dispatcher_update_task
+ (
+ String info_file_path,
+ Var(List(DispatcherInfo)) info_v,
+ Var(Int32) info_date_v
+ ) =
+ sleep(3000);
+ (if dispatcher_update_data(info_file_path,info_v,info_date_v)
+ then unique
+ else dispatcher_update_error(info_file_path));
+ dispatcher_update_task(info_file_path,info_v,info_date_v).
+
+
+public define One
+ start_web_dispatcher
+ (
+ Int32 ip_address, // address for listening (typically 0: listen on all interfaces)
+ Int32 http_port, // typically 80
+ DenialOfService dos
+ ) =
+ with info_file_path = my_anubis_directory+"/web_sites/dispatcher.info",
+ info_v = var((List(DispatcherInfo))[]),
+ info_date_v = var((Int32)0),
+ if dispatcher_update_data(info_file_path,info_v,info_date_v)
+ then if start_server(ip_address,
+ http_port,
+ make_dispatcher_handler(info_v,dos),
+ (One u)|->u) is
+ {
+ cannot_create_the_socket then
+ print("Cannot create the socket for HTTP server.\n"),
+ cannot_bind_to_port then
+ print("Cannot bind HTTP server to port "+http_port+".\n"),
+ cannot_listen_on_port then
+ print("HTTP server cannot listen on port "+http_port+".\n"),
+ ok(http_server) then
+ dispatcher_update_task(info_file_path,info_v,info_date_v)
+ }
+ else dispatcher_update_error(info_file_path).
+
+
+
+ *** [7.2] The dispatcher web site.
+
+ global define One
+ web_dispatcher
+ (
+ List(String) args
+ ) =
+ start_web_dispatcher(0,80,load_denial_of_service_info).
+
+
+
+
+
+
+ *** [7.3] Managing the info file.
+
+define Int32
+ register_ip_address
+ =
+ if ip_address(prompt(" numerical IP address (for HTTP): ")) is
+ {
+ failure then print(" *** Error: incorrect IP address.\n");
+ register_ip_address,
+ success(n) then n
+ }.
+
+
+define Int32
+ register_ip_port
+ =
+ if string_to_integer(prompt(" IP port (for HTTP): ")) is
+ {
+ failure then print(" *** Error: incorrect IP port.\n");
+ register_ip_port,
+ success(p) then if (0 =< p & p =< 65535)
+ then p
+ else print(" *** Error: IP port out of bounds.\n");
+ register_ip_port
+ }.
+
+
+define One
+ register_new_site
+ (
+ Var(List(DispatcherInfo)) info_v
+ ) =
+ print("\n");
+ print(" Registering a new site:\n");
+ with name = prompt(" Site name: "),
+ with addr = register_ip_address,
+ with port = register_ip_port,
+ (protect info_v <- [site(name,port) . *info_v]);
+ print(" Site "+name+" at "+ip_addr_to_string(addr)+":"+port+" added\n (but not saved to disk).\n").
+
+
+define List(DispatcherInfo)
+ find_sites
+ (
+ List(DispatcherInfo) l,
+ String name
+ ) =
+ if l is
+ {
+ [ ] then [ ],
+ [h . t] then if h is site(n,_) then
+ if find(name,n,0) is
+ {
+ failure then find_sites(t,name),
+ success(_) then [h . find_sites(t,name)]
+ }
+ }.
+
+
+define String
+ pad
+ (
+ String s,
+ Int32 l
+ ) =
+ if length(s) >= l
+ then s
+ else s+constant_string(l-length(s),' ').
+
+
+
+define One
+ show_sites_1
+ (
+ List(DispatcherInfo) l,
+ Int32 i
+ ) =
+ if l is
+ {
+ [ ] then unique,
+ [h . t] then if h is site(name,port) then
+ print(" ["+i+"] "+pad(name,40)+" "+" "+port+"\n");
+ show_sites_1(t,i+1)
+ }.
+
+
+define One
+ show_sites
+ (
+ List(DispatcherInfo) l,
+ Int32 i
+ ) =
+ print(" Name Port\n");
+ print(" --------------------------------------------------------\n");
+ show_sites_1(l,i).
+
+define List(DispatcherInfo)
+ replace_info
+ (
+ List(DispatcherInfo) l,
+ String site_name,
+ Int32 new_port
+ ) =
+ if l is
+ {
+ [ ] then alert,
+ [h . t] then if h is site(n,_) then
+ if n = site_name
+ then [site(n,new_port) . t]
+ else [h . replace_info(t,site_name,new_port)]
+ }.
+
+define List(DispatcherInfo)
+ delete_info
+ (
+ List(DispatcherInfo) l,
+ String site_name,
+ ) =
+ if l is
+ {
+ [ ] then alert,
+ [h . t] then if h is site(n,_) then
+ if n = site_name
+ then t
+ else [h . delete_info(t,site_name)]
+ }.
+
+
+define One
+ update_site
+ (
+ Var(List(DispatcherInfo)) info_v,
+ String site_name,
+ Int32 old_port
+ ) =
+ print("\n");
+ print(" Updating site '"+site_name+"': (currently: "+old_port+")\n");
+ with new_port = register_ip_port,
+ answer = prompt(" Update '"+site_name+"' as: "+new_port+" [Y/N] ? "),
+ if (answer = "Y" | answer = "y")
+ then info_v <- replace_info(*info_v,site_name,new_port)
+ else unique.
+
+
+
+define Bool
+ compare
+ (
+ DispatcherInfo d1,
+ DispatcherInfo d2
+ ) =
+ if d1 is site(n1,_) then
+ if d2 is site(n2,_) then
+ string_less(n1,n2).
+
+
+
+define One
+ update_site
+ (
+ Var(List(DispatcherInfo)) info_v
+ ) =
+ print("\n");
+ with prefix = prompt(" Search for site to update: "),
+ if find_sites(*info_v,prefix) is
+ {
+ [ ] then print(" No site found.\n");
+ update_site(info_v),
+ [h . t] then
+ show_sites(qsort([h . t],compare),1);
+ with i1 = prompt(" Choose a site to update [1/.../"+(length(t)+1)+"]: "),
+ if string_to_integer(i1) is
+ {
+ failure then print(" *** Error: site number not recognized.\n");
+ update_site(info_v),
+ success(ii1) then if nth(ii1-1,*info_v) is
+ {
+ failure then print(" *** Error: site number "+i1+" does not exist.\n");
+ update_site(info_v),
+ success(site_info) then if site_info is site(name,old_port) then
+ update_site(info_v,name,old_port)
+ }
+ }
+ }.
+
+
+define One
+ delete_site
+ (
+ Var(List(DispatcherInfo)) info_v,
+ String site_name,
+ Int32 old_port
+ ) =
+ print("\n");
+ print(" Deleting site '"+site_name+"': (currently: "+old_port+")\n");
+ with answer = prompt(" Are you sure you want to delete site: '"+site_name+"' [Y/N] ? "),
+ if (answer = "Y" | answer = "y")
+ then info_v <- delete_info(*info_v,site_name)
+ else print(" Site '"+site_name+"' not deleted.\n").
+
+
+define One
+ delete_site
+ (
+ Var(List(DispatcherInfo)) info_v
+ ) =
+ print("\n");
+ with prefix = prompt(" Search for site to delete: "),
+ if find_sites(*info_v,prefix) is
+ {
+ [ ] then print(" No site found.\n");
+ delete_site(info_v),
+ [h . t] then
+ show_sites(qsort([h . t],compare),1);
+ with i1 = prompt(" Choose a site to delete [1/.../"+(length(t)+1)+"]: "),
+ if string_to_integer(i1) is
+ {
+ failure then print(" *** Error: site number not recognized.\n");
+ delete_site(info_v),
+ success(ii1) then if nth(ii1-1,*info_v) is
+ {
+ failure then print(" *** Error: site number "+i1+" does not exist.\n");
+ delete_site(info_v),
+ success(site_info) then if site_info is site(name,old_port) then
+ delete_site(info_v,name,old_port)
+ }
+ }
+ }.
+
+
+define One
+ manager
+ (
+ Var(List(DispatcherInfo)) info_v,
+ String file_path
+ ) =
+ print("\n");
+ print(" --- Welcome to the Web Dispatcher Manager ---\n");
+ with l = length(*info_v),
+ print(" "+l+" site"+(if l>1 then "s" else "")+" currently registred.\n");
+ print(" [L] List registered sites.\n");
+ print(" [R] Register a new site.\n");
+ print(" [U] Update a registred site.\n");
+ print(" [D] Delete a registred site.\n");
+ with propose_write_v = var((Bool)true),
+ action = prompt(" Choose an action [L/R/U/D]: "),
+ (if (action = "L" | action = "l") then (show_sites(*info_v,1); propose_write_v <- false) else
+ if (action = "R" | action = "r") then register_new_site(info_v) else
+ if (action = "U" | action = "u") then update_site(info_v) else
+ if (action = "D" | action = "d") then delete_site(info_v) else
+ print("Action not recognized.\n"));
+ print("\n");
+ if *propose_write_v then
+ with result = prompt(" Write modifications to data base [Y/N] ?"),
+ if (result = "Y" | result = "y")
+ then if save(*info_v,file_path) is
+ {
+ cannot_open_file then print(" File '"+file_path+"' not found.\n"),
+ write_error then print(" Error while writing file '"+file_path+"'.\n"),
+ ok then print(" Data base has been modified.\n")
+ }
+ else print(" Data base not modified.\n")
+ else unique.
+
+
+
+global define One
+ manage_web_dispatcher
+ (
+ List(String) args
+ ) =
+ with info_v = var((List(DispatcherInfo))[]),
+ with file_path = my_anubis_directory+"/web_sites/dispatcher.info",
+ if (RetrieveResult(List(DispatcherInfo)))retrieve(file_path) is
+ {
+ cannot_find_file then print("File '"+file_path+"' does not exist.\n");
+ with answer = prompt("Create it [Y/N] ? "),
+ if (answer = "Y" | answer = "y")
+ then if save((List(DispatcherInfo))[],file_path) is
+ {
+ cannot_open_file then
+ print("Cannot create file '"+file_path+"'.\n"),
+ write_error then
+ print("Error while creating file '"+file_path+"'.\n"),
+ ok then manager(info_v,file_path)
+ }
+ else unique,
+ read_error then print("Error while reading file '"+file_path+"'.\n"),
+ type_error then print("File '"+file_path+"' is corrupted.\n"),
+ ok(info) then info_v <- info;
+ manager(info_v,file_path)
+ }.
+
+
+
+
+
--
libgit2 0.21.4