diff --git a/calexium_lib/web/CXM_multihost_http_server.anubis b/calexium_lib/web/CXM_multihost_http_server.anubis
index fe7b150..d98a23b 100644
--- a/calexium_lib/web/CXM_multihost_http_server.anubis
+++ b/calexium_lib/web/CXM_multihost_http_server.anubis
@@ -1,3825 +1,3826 @@
-
- *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.
-
-type BufferedConnection:
- buffered_connection(Connection conn,
- Var(ByteArray) buffer,
- Var(Int32) read_pos).
-
-
-
- *** [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 String
- pid
- =
- "[" + virtual_machine_id + "] ".
-
-define ReadResult
- read
- (
- BufferedConnection connection,
- Int32 size,
- Int32 time_out
- ) =
- //println(pid + "read(" + size + ")");
-
- if *connection.read_pos < length(*connection.buffer) then
- //println(pid + " reading from buffer (size = " + length(*connection.buffer) + ", pos = " + *connection.read_pos);
- with result = extract(*connection.buffer, *connection.read_pos, *connection.read_pos + size),
- size_read = length(result),
- connection.read_pos <- *connection.read_pos + size_read;
- if size > size_read
- then
- //println("Wanted " + size + ", read only " + size_read);
- if read(connection, size - size_read, time_out) is
- {
- error then error,
- timeout then ok(result),
- ok(ba) then ok(result + ba)
- }
- else ok(result)
- else
- //if now > dead_line then record_dubious_connection(connection,dead_line,dos) else
- if read(connection.conn, 16384, time_out) is // the connection is closed after 10 minutes of inactivity
- {
- error then println(pid + "read failed)"); error,
- timeout then timeout,
- ok(ba) then
-// println(pid + "ba = " + length(ba));
- connection.buffer <- ba;
- connection.read_pos <- 0;
- //println(pid + "rb = " + length(*read_buffer));
- read(connection, size, time_out)
- }.
-
-
-define Result(Error,Word8)
- read_one_byte
- (
- BufferedConnection 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
-// println("-" + pid + "read [" + implode([c]) + "]\t");
- ok(c)
- }
- }.
-
-
-variable ByteArray read_buffer = constant_byte_array(0, 0).
-variable Int32 read_offset = 0.
-
- define Result(Error,Word8)
- read_one_byte
- (
- BufferedConnection connection,
- Int32 dead_line,
- DenialOfService dos
- ) =
- if *read_offset < length(*read_buffer) then
- if nth(*read_offset, *read_buffer) is
- {
- failure then println(pid + "nth failed)"); error(cannot_read_from_connection),
- success(c) then
- println("-" + pid + "read [" + implode([c]) + "]\tat " + *read_offset);
- read_offset <- *read_offset + 1;
- ok(c)
- }
- else
- //if now > dead_line then record_dubious_connection(connection,dead_line,dos) else
- println(pid + "len = " + length(*read_buffer));
- if read(connection, 16384, 600) is // the connection is closed after 10 minutes of inactivity
- {
- error then println(pid + "read failed)"); error(cannot_read_from_connection),
- timeout then error(timeout(600)),
- //record_dubious_connection(connection,dead_line,dos),
- ok(ba) then
- println(pid + "ba = " + length(ba));
- read_buffer <- ba;
- read_offset <- 0;
- println(pid + "rb = " + length(*read_buffer));
- read_one_byte(connection, dead_line, dos)
- }.
-
-
-define Result(Error,Word8)
- next_char // reading a character (check the list first, and read on the connection
- // only when the list is empty).
- (
- BufferedConnection 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
- (
- BufferedConnection 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
- (
- BufferedConnection 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
- (
- BufferedConnection 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
- (
- BufferedConnection 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
- (
- BufferedConnection 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
- (
- BufferedConnection 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
- (
- BufferedConnection 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
- (
- BufferedConnection 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
- (
- BufferedConnection 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
- (
- BufferedConnection 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
- (
- BufferedConnection 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
- (
- BufferedConnection 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
- (
- BufferedConnection 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)]
- }.
-
-
-
-define String
- month_abrv
- (
- Date_and_Time d
- ) =
- if d.month = 1 then "Jan"
- else if d.month = 2 then "Feb"
- else if d.month = 3 then "Mar"
- else if d.month = 4 then "Apr"
- else if d.month = 5 then "May"
- else if d.month = 6 then "Jun"
- else if d.month = 7 then "Jul"
- else if d.month = 8 then "Aug"
- else if d.month = 9 then "Sep"
- else if d.month = 10 then "Oct"
- else if d.month = 11 then "Nov"
- else if d.month = 12 then "Dec"
- else
- println("Bad month value [" + d.month + "] on Date_and_Time");
- "XXX".
-
-define String
- weekday_abrv
- (
- Date_and_Time d
- ) =
- if d.week_day = 0 then "Sun"
- else if d.week_day = 1 then "Mon"
- else if d.week_day = 2 then "Tue"
- else if d.week_day = 3 then "Wed"
- else if d.week_day = 4 then "Thu"
- else if d.week_day = 5 then "Fri"
- else if d.week_day = 6 then "Sat"
- else
- println("Bad weekday value [" + d.week_day + "] on Date_and_Time");
- "XXX".
-
-/**
- * Format a date with the followin format : "Mon, 23 Jul 2007 11:33:43 GMT"
- * Currently, this function can't output a GMT time, but only local time.
- * So the final GMT is totally fake, but needed by protocol.
- */
-public define String
- format_http_date
- (
- Date_and_Time d
- ) =
- weekday_abrv(d) + ", " + zero_pad_n(2,day(d)) + " " + month_abrv(d) + " " + year(d)
- + " " + zero_pad_n(2,hour(d)) + ":" + zero_pad_n(2,minute(d)) + ":" + zero_pad_n(2,second(d)) + " GMT".
-
-/**
- * Same as previous format_http_date() function, but with seconds count from the UNIX epoch as input.
- */
-public define String
- format_http_date
- (
- Int32 date
- ) =
- format_http_date(convert_time(date)).
-
-
- *** [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,
- String etag,
- Maybe(FileTimes) mb_ftimes,
- ) =
- with headers = (List(HTTP_header))
- [
- http_header("Content-Type",mime_type),
- http_header("Etag", etag),
- http_header("Content-Length",integer_to_string(size)),
- ],
- if mb_ftimes is
- {
- failure then headers,
- success(ftimes) then [http_header("Last-Modified", format_http_date(ftimes.last_modified)) . headers]
- }
- .
-
-
-
- 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)
- }
- }.
-
-
-define String
- compute_etag
- (
- String filename,
- Maybe(FileTimes) mb_ftimes,
- Int32 size,
- ) =
- if mb_ftimes is
- {
- failure then println("Warning: no file times for '" + filename + "', etag won't be very accurate."); to_ascii(sha1((filename, size))),
- success(ftimes) then to_ascii(sha1((filename, ftimes, size)))
- }.
-
-define Bool
- are_same_etag
- (
- Maybe(String) input_etag,
- String current_etag
- ) =
- if input_etag is
- {
- failure then false,
- success(etag) then etag = current_etag
- }.
-
- Sending the answer line, the headers and the body.
-
-define One
- send_file
- (
- Web_Site_Description desc,
- Connection connection,
- List(HTTP_header) input_headers,
- List(HTTP_header) headers,
- Int32 size,
- Connection file,
- String filename,
- String full_path,
- String mime_type,
- One -> One action_before_send_file
- ) =
- action_before_send_file(unique);
- with input_etag = http_header_value(input_headers, "If-None-Match"),
- mb_ftimes = get_file_times(full_path),
- current_etag = compute_etag(full_path, mb_ftimes, size),
- if are_same_etag(input_etag, current_etag) is
- {
- false then
- forget(reliable_write(connection,to_byte_array("HTTP/1.1 200 OK"+crlf)));
- forget(reliable_write(connection,[format_headers(headers + headers_for_send_file(mime_type, size, current_etag, mb_ftimes)) , crlf]));
- send_file_body(desc,connection,file,size,0,filename),
- true then
- forget(reliable_write(connection,to_byte_array("HTTP/1.1 304 Not Modified"+crlf)));
- forget(reliable_write(connection,[format_headers([http_header("Etag", current_etag) . 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,
- List(HTTP_header) input_headers,
- List(HTTP_header) output_headers,
- 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,
- input_headers,
- output_headers,
- size,
- file(f),
- uri,
- path,
- mime_type,
- 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),
- mime_type = if recognize_mime_type_from_uri(desc,uri) is
- {
- failure then "application/octet-stream"
- success(mime_type) then mime_type
- },
- send_file(desc,
- connection,
- input_headers,
- output_headers,
- size,
- file(f),
- uri,
- absolute_path,
- mime_type,
- action_before_send_file)
- }
- )
- else log_journal_msg(desc,"Cannot find or read authorization file.\n")
- }.
-
-
-
-
-
-
-
-
- *** [5.6] Answering a www-url encoded request.
-
- Standard headers are for answering ".awp" requests.
-
-define List(HTTP_header)
- standard_headers
- =
- [
- http_header("Date", format_http_date(now)),
- http_header("Server", "Anubis Embedded Server v" + major_version_number + "." + minor_version_number)
- ].
-
-define List(HTTP_header)
- standard_headers_for_html
- (
- 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),
- format_headers(standard_headers_for_html(length(answer_body),charset(desc))),
- format_headers(additional_headers),
- crlf .
- answer_body])))
- else (send_file(desc,
- connection,
- uri,
- headers,
- standard_headers,
- 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_for_html(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,
- BufferedConnection 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.conn) 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.conn, 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 conn) |->
- if remote_IP_address_and_port(conn) is (addr,_) then
- if is_dubious_IP(addr,dos)
- then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
- else
- with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),
- http_https_handler(sites, connection, false, dos).
-
-define Server -> (SSL_Connection -> One)
- make_https_handler
- (
- List(Web_Site_Description) sites,
- DenialOfService dos
- ) =
- (Server server) |-> (SSL_Connection conn) |->
- with connection = buffered_connection(ssl(conn), var(constant_byte_array(0, 0)), var(0)),
- http_https_handler(sites, 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,
- connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),
- if read_request_line(connection, start_time+*request_line_delay(dos), dos) is
- {
- error(msg) then print(format(msg)),
- ok(request_line) then
- if read_http_headers(connection, 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.
+
+type BufferedConnection:
+ buffered_connection(Connection conn,
+ Var(ByteArray) buffer,
+ Var(Int32) read_pos).
+
+
+
+ *** [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 String
+ pid
+ =
+ "[" + virtual_machine_id + "] ".
+
+define ReadResult
+ read
+ (
+ BufferedConnection connection,
+ Int32 size,
+ Int32 time_out
+ ) =
+ //println(pid + "read(" + size + ")");
+
+ if *connection.read_pos < length(*connection.buffer) then
+ //println(pid + " reading from buffer (size = " + length(*connection.buffer) + ", pos = " + *connection.read_pos);
+ with result = extract(*connection.buffer, *connection.read_pos, *connection.read_pos + size),
+ size_read = length(result),
+ connection.read_pos <- *connection.read_pos + size_read;
+ if size > size_read
+ then
+ //println("Wanted " + size + ", read only " + size_read);
+ if read(connection, size - size_read, time_out) is
+ {
+ error then error,
+ timeout then ok(result),
+ ok(ba) then ok(result + ba)
+ }
+ else ok(result)
+ else
+ //if now > dead_line then record_dubious_connection(connection,dead_line,dos) else
+ if read(connection.conn, 16384, time_out) is // the connection is closed after 10 minutes of inactivity
+ {
+ error then println(pid + "read failed)"); error,
+ timeout then timeout,
+ ok(ba) then
+// println(pid + "ba = " + length(ba));
+ connection.buffer <- ba;
+ connection.read_pos <- 0;
+ //println(pid + "rb = " + length(*read_buffer));
+ read(connection, size, time_out)
+ }.
+
+
+define Result(Error,Word8)
+ read_one_byte
+ (
+ BufferedConnection 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
+// println("-" + pid + "read [" + implode([c]) + "]\t");
+ ok(c)
+ }
+ }.
+
+
+variable ByteArray read_buffer = constant_byte_array(0, 0).
+variable Int32 read_offset = 0.
+
+ define Result(Error,Word8)
+ read_one_byte
+ (
+ BufferedConnection connection,
+ Int32 dead_line,
+ DenialOfService dos
+ ) =
+ if *read_offset < length(*read_buffer) then
+ if nth(*read_offset, *read_buffer) is
+ {
+ failure then println(pid + "nth failed)"); error(cannot_read_from_connection),
+ success(c) then
+ println("-" + pid + "read [" + implode([c]) + "]\tat " + *read_offset);
+ read_offset <- *read_offset + 1;
+ ok(c)
+ }
+ else
+ //if now > dead_line then record_dubious_connection(connection,dead_line,dos) else
+ println(pid + "len = " + length(*read_buffer));
+ if read(connection, 16384, 600) is // the connection is closed after 10 minutes of inactivity
+ {
+ error then println(pid + "read failed)"); error(cannot_read_from_connection),
+ timeout then error(timeout(600)),
+ //record_dubious_connection(connection,dead_line,dos),
+ ok(ba) then
+ println(pid + "ba = " + length(ba));
+ read_buffer <- ba;
+ read_offset <- 0;
+ println(pid + "rb = " + length(*read_buffer));
+ read_one_byte(connection, dead_line, dos)
+ }.
+
+
+define Result(Error,Word8)
+ next_char // reading a character (check the list first, and read on the connection
+ // only when the list is empty).
+ (
+ BufferedConnection 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
+ (
+ BufferedConnection 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
+ (
+ BufferedConnection 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
+ (
+ BufferedConnection 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
+ (
+ BufferedConnection 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
+ (
+ BufferedConnection 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
+ (
+ BufferedConnection 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 print("**** ALERT **** badly formatted argument [" + s + "]!!!\n");
+ []
+ }.
+
+
+
+
+
+ *** [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
+ (
+ BufferedConnection 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
+ (
+ BufferedConnection 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
+ (
+ BufferedConnection 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
+ (
+ BufferedConnection 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
+ (
+ BufferedConnection 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
+ (
+ BufferedConnection 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
+ (
+ BufferedConnection 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)]
+ }.
+
+
+
+define String
+ month_abrv
+ (
+ Date_and_Time d
+ ) =
+ if d.month = 1 then "Jan"
+ else if d.month = 2 then "Feb"
+ else if d.month = 3 then "Mar"
+ else if d.month = 4 then "Apr"
+ else if d.month = 5 then "May"
+ else if d.month = 6 then "Jun"
+ else if d.month = 7 then "Jul"
+ else if d.month = 8 then "Aug"
+ else if d.month = 9 then "Sep"
+ else if d.month = 10 then "Oct"
+ else if d.month = 11 then "Nov"
+ else if d.month = 12 then "Dec"
+ else
+ println("Bad month value [" + d.month + "] on Date_and_Time");
+ "XXX".
+
+define String
+ weekday_abrv
+ (
+ Date_and_Time d
+ ) =
+ if d.week_day = 0 then "Sun"
+ else if d.week_day = 1 then "Mon"
+ else if d.week_day = 2 then "Tue"
+ else if d.week_day = 3 then "Wed"
+ else if d.week_day = 4 then "Thu"
+ else if d.week_day = 5 then "Fri"
+ else if d.week_day = 6 then "Sat"
+ else
+ println("Bad weekday value [" + d.week_day + "] on Date_and_Time");
+ "XXX".
+
+/**
+ * Format a date with the followin format : "Mon, 23 Jul 2007 11:33:43 GMT"
+ * Currently, this function can't output a GMT time, but only local time.
+ * So the final GMT is totally fake, but needed by protocol.
+ */
+public define String
+ format_http_date
+ (
+ Date_and_Time d
+ ) =
+ weekday_abrv(d) + ", " + zero_pad_n(2,day(d)) + " " + month_abrv(d) + " " + year(d)
+ + " " + zero_pad_n(2,hour(d)) + ":" + zero_pad_n(2,minute(d)) + ":" + zero_pad_n(2,second(d)) + " GMT".
+
+/**
+ * Same as previous format_http_date() function, but with seconds count from the UNIX epoch as input.
+ */
+public define String
+ format_http_date
+ (
+ Int32 date
+ ) =
+ format_http_date(convert_time(date)).
+
+
+ *** [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,
+ String etag,
+ Maybe(FileTimes) mb_ftimes,
+ ) =
+ with headers = (List(HTTP_header))
+ [
+ http_header("Content-Type",mime_type),
+ http_header("Etag", etag),
+ http_header("Content-Length",integer_to_string(size)),
+ ],
+ if mb_ftimes is
+ {
+ failure then headers,
+ success(ftimes) then [http_header("Last-Modified", format_http_date(ftimes.last_modified)) . headers]
+ }
+ .
+
+
+
+ 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)
+ }
+ }.
+
+
+define String
+ compute_etag
+ (
+ String filename,
+ Maybe(FileTimes) mb_ftimes,
+ Int32 size,
+ ) =
+ if mb_ftimes is
+ {
+ failure then println("Warning: no file times for '" + filename + "', etag won't be very accurate."); to_ascii(sha1((filename, size))),
+ success(ftimes) then to_ascii(sha1((filename, ftimes, size)))
+ }.
+
+define Bool
+ are_same_etag
+ (
+ Maybe(String) input_etag,
+ String current_etag
+ ) =
+ if input_etag is
+ {
+ failure then false,
+ success(etag) then etag = current_etag
+ }.
+
+ Sending the answer line, the headers and the body.
+
+define One
+ send_file
+ (
+ Web_Site_Description desc,
+ Connection connection,
+ List(HTTP_header) input_headers,
+ List(HTTP_header) headers,
+ Int32 size,
+ Connection file,
+ String filename,
+ String full_path,
+ String mime_type,
+ One -> One action_before_send_file
+ ) =
+ action_before_send_file(unique);
+ with input_etag = http_header_value(input_headers, "If-None-Match"),
+ mb_ftimes = get_file_times(full_path),
+ current_etag = compute_etag(full_path, mb_ftimes, size),
+ if are_same_etag(input_etag, current_etag) is
+ {
+ false then
+ forget(reliable_write(connection,to_byte_array("HTTP/1.1 200 OK"+crlf)));
+ forget(reliable_write(connection,[format_headers(headers + headers_for_send_file(mime_type, size, current_etag, mb_ftimes)) , crlf]));
+ send_file_body(desc,connection,file,size,0,filename),
+ true then
+ forget(reliable_write(connection,to_byte_array("HTTP/1.1 304 Not Modified"+crlf)));
+ forget(reliable_write(connection,[format_headers([http_header("Etag", current_etag) . 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,
+ List(HTTP_header) input_headers,
+ List(HTTP_header) output_headers,
+ 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,
+ input_headers,
+ output_headers,
+ size,
+ file(f),
+ uri,
+ path,
+ mime_type,
+ 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),
+ mime_type = if recognize_mime_type_from_uri(desc,uri) is
+ {
+ failure then "application/octet-stream"
+ success(mime_type) then mime_type
+ },
+ send_file(desc,
+ connection,
+ input_headers,
+ output_headers,
+ size,
+ file(f),
+ uri,
+ absolute_path,
+ mime_type,
+ action_before_send_file)
+ }
+ )
+ else log_journal_msg(desc,"Cannot find or read authorization file.\n")
+ }.
+
+
+
+
+
+
+
+
+ *** [5.6] Answering a www-url encoded request.
+
+ Standard headers are for answering ".awp" requests.
+
+define List(HTTP_header)
+ standard_headers
+ =
+ [
+ http_header("Date", format_http_date(now)),
+ http_header("Server", "Anubis Embedded Server v" + major_version_number + "." + minor_version_number)
+ ].
+
+define List(HTTP_header)
+ standard_headers_for_html
+ (
+ 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),
+ format_headers(standard_headers_for_html(length(answer_body),charset(desc))),
+ format_headers(additional_headers),
+ crlf .
+ answer_body])))
+ else (send_file(desc,
+ connection,
+ uri,
+ headers,
+ standard_headers,
+ 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_for_html(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,
+ BufferedConnection 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.conn) 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.conn, 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 conn) |->
+ if remote_IP_address_and_port(conn) is (addr,_) then
+ if is_dubious_IP(addr,dos)
+ then print("Rejecting dubious IP address "+ip_addr_to_string(addr)+"\n")
+ else
+ with connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),
+ http_https_handler(sites, connection, false, dos).
+
+define Server -> (SSL_Connection -> One)
+ make_https_handler
+ (
+ List(Web_Site_Description) sites,
+ DenialOfService dos
+ ) =
+ (Server server) |-> (SSL_Connection conn) |->
+ with connection = buffered_connection(ssl(conn), var(constant_byte_array(0, 0)), var(0)),
+ http_https_handler(sites, 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,
+ connection = buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0)),
+ if read_request_line(connection, start_time+*request_line_delay(dos), dos) is
+ {
+ error(msg) then print(format(msg)),
+ ok(request_line) then
+ if read_http_headers(connection, 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 print("ALERT: Empty list into replace_info() [" + __FILE__ + "]\n"); [],
+ [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 print("ALERT: Empty list into delete_info() [" + __FILE__ + "]\n"); [],
+ [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)
+ }.
+
+
+
+
+
diff --git a/calexium_lib/web/CXM_web_arg_encode.anubis b/calexium_lib/web/CXM_web_arg_encode.anubis
index a6ae72c..c92c854 100644
--- a/calexium_lib/web/CXM_web_arg_encode.anubis
+++ b/calexium_lib/web/CXM_web_arg_encode.anubis
@@ -1,340 +1,340 @@
-
- *Project* The Anubis Project
-
- *Title* Encoding data for web argument values.
-
- *Copyright* Copyright (c) Alain Prouté 2002.
-
-
- *Author* Alain Prouté
-
-
-
- *Overview*
- This file contains encoding and decoding functions which allow to put any serializable
- datum as the value of a web argument. The datum is serialized, and the result of
- serialization (a byte array) is encoded in such a way that it can safely be used as the
- value of a web argument. The encoding process is similar to the standard process
- 'base64', but nevertheless different, because base64 is not suitable for that purpose.
-
-
-public define String
- web_arg_encode
- (
- $T datum
- ).
-
-public define Maybe($T)
- web_arg_decode
- (
- String encoded_value
- ).
-
- Of course, since the type of the datum is not available from 'encoded_value', a term
- like 'web_arg_decode(my_string)' must generally be explicitly typed, like this:
-
- (Maybe(MyType))web_arg_decode(my_string)
-
-
- These functions are used for example in 'anubis/library/web/kernel.anubis'.
-
-
-
-
-
- --- That's all for the public part. ---------------------------------------------------
-
-read tools/basis.anubis
-
- Our algorithms are copy-pasted from 'base64.anubis' and slightly modified. The point is
- twofold:
-
- (1) base64 encoding inserts carriage return (CR) and line feed (LF) characters every
- 76 character, but CR and LF are not suitable in the values of a web argument,
-
- (2) the base64 alphabet uses '+' and '/', which are also not suitable in the value of
- a web argument, because they have special meanings.
-
- Hence, we just have to modify the base64 algorithms, so as not to generate any CR or
- LF, and use '-' and '_' instead of '+' and '/'. Also, we do not use padding characters
- '=', which are needless (as remarked in 'anubis/library/tools/base64.anubis').
-
-
-
- *** Encoding. *************************************************************************
-
- Translate an index into a wa64 character.
-
-define Word8
- wa64_alphabet
- (
- Int32 index // the index is assumed to be >= 0 and < 64
- ) =
- if index < 0 then alert else
- if index < 26 then truncate_to_word8(index+'A') else
- if index < 52 then truncate_to_word8(index-26+'a') else
- if index < 62 then truncate_to_word8(index-52+'0') else
- if index = 62 then '-' else
- if index = 63 then '_' else
- alert.
-
-
-
- Transform a group of 3 bytes into a group of 4 wa64 letters.
-
-define (Word8,Word8,Word8,Word8)
- transform_group
- (
- Word8 byte1,
- Word8 byte2,
- Word8 byte3
- ) =
- with n1 = word8_to_int32(byte1),
- n2 = word8_to_int32(byte2),
- n3 = word8_to_int32(byte3),
- (
- wa64_alphabet(n1>>2),
- wa64_alphabet(((n1&3)<<4)|(n2>>4)),
- wa64_alphabet(((n2&15)<<2)|(n3>>6)),
- wa64_alphabet(n3&63)
- ).
-
-
- Transform a group of two bytes.
-
-define ByteArray
- two_mod_three
- (
- ByteArray result,
- Int32 result_index,
- Word8 byte1,
- Word8 byte2
- ) =
- with n1 = word8_to_int32(byte1),
- n2 = word8_to_int32(byte2),
- forget(put(result,result_index ,wa64_alphabet(n1>>2)));
- forget(put(result,result_index+1,wa64_alphabet(((n1&3)<<4)|(n2>>4))));
- forget(put(result,result_index+2,wa64_alphabet((n2&15)<<2)));
- forget(put(result,result_index+4,0));
- result.
-
-
-
- Transform a 'group of one byte'.
-
-define ByteArray
- one_mod_three
- (
- ByteArray result,
- Int32 result_index,
- Word8 byte1
- ) =
- with n1 = word8_to_int32(byte1),
- forget(put(result,result_index ,wa64_alphabet(n1>>2)));
- forget(put(result,result_index+1,wa64_alphabet((n1&3)<<4)));
- forget(put(result,result_index+4,0));
- result.
-
-
-
-define ByteArray
- wa64_encode
- (
- ByteArray ba,
- Int32 ba_index, // index into byte array
- ByteArray result,
- Int32 result_index
- ) =
- if nth(ba_index,ba) is
- {
- failure then forget(put(result,result_index,0)); result, // no new block of 3 bytes
- success(byte1) then
- if nth(ba_index+1,ba) is
- {
- failure then one_mod_three(result,result_index,byte1),
- success(byte2) then
- if nth(ba_index+2,ba) is
- {
- failure then two_mod_three(result,result_index,byte1,byte2),
- success(byte3) then
- if transform_group(byte1,byte2,byte3) is (c1,c2,c3,c4) then
- (
- forget(put(result,result_index,c1));
- forget(put(result,result_index+1,c2));
- forget(put(result,result_index+2,c3));
- forget(put(result,result_index+3,c4));
- wa64_encode(ba,
- ba_index+3,
- result,
- result_index+4)
- )
- }
- }
- }.
-
-
-
-define ByteArray
- wa64_encode
- (
- ByteArray ba
- ) =
- with l = length(ba),
- wa64_encode(ba,0,
- constant_byte_array((((l/57)+1)*76)+10,0),0).
-
-
-public define String
- web_arg_encode
- (
- $T datum
- ) =
- to_string(wa64_encode(serialize(datum))).
-
-
-
-
-
- *** Decoding. *************************************************************************
-
- See the comments in 'anubis/library/tools/base64.anubis'.
-
- Checking if a character belongs to the wa64 alphabet. If true, the function returns the
- index of the character in the alphabet.
-
-define Maybe(Int32)
- is_wa64_char
- (
- Word8 c
- ) =
- with n = word8_to_int32(c),
- if ('A' =< n & n =< 'Z') then success(n - 'A') else
- if ('a' =< n & n =< 'z') then success(n - 'a' + 26) else
- if ('0' =< n & n =< '9') then success(n - '0' + 52) else
- if n = '-' then success(62) else
- if n = '_' then success(63) else
- failure.
-
-
-
- Getting the next wa64 character from the input. The function returns the next position
- for reading. The function does not return the character itself, but its index in the
- alphabet.
-
-define Maybe((Int32, // next position for reading
- Int32)) // index of character in wa64 alphabet
- get_next_character
- (
- ByteArray ba,
- Int32 n
- ) =
- if nth(n,ba) is
- {
- failure then failure,
- success(c) then
- if is_wa64_char(c) is
- {
- failure then failure,
- success(i) then success((n+1,i))
- }
- }.
-
-
- Translating a group of characters into a group of bytes.
-
-type TranslateGroupResult:
- three_bytes (Int32 new_pos, Word8 b1, Word8 b2, Word8 b3),
- two_bytes ( Word8 b1, Word8 b2 ),
- one_byte ( Word8 b1 ),
- zero_bytes,
- error.
-
-
-define TranslateGroupResult
- translate_group
- (
- ByteArray ba,
- Int32 n
- ) =
- if get_next_character(ba,n) is
- {
- failure then zero_bytes,
- success(p1) then if p1 is (n1,i1) then
- if get_next_character(ba,n1) is
- {
- failure then error,
- success(p2) then if p2 is (n2,i2) then
- if get_next_character(ba,n2) is
- {
- failure then // we don't check the padding characters
- one_byte(truncate_to_word8((i1<<2)|(i2>>4))),
- success(p3) then if p3 is (n3,i3) then
- if get_next_character(ba,n3) is
- {
- failure then
- two_bytes(truncate_to_word8((i1<<2)|(i2>>4)),
- truncate_to_word8(((i2&15)<<4)|(i3>>2))),
- success(p4) then if p4 is (n4,i4) then
- three_bytes(n4,truncate_to_word8((i1<<2)|(i2>>4)),
- truncate_to_word8(((i2&15)<<4)|(i3>>2)),
- truncate_to_word8(((i3&3)<<6)|i4))
- }
- }
- }
- }.
-
-
-define Int32 // returns the size of the decoded array of bytes
- translate_groups
- (
- ByteArray source,
- Int32 n, // position in source
- ByteArray target,
- Int32 m // position in target
- ) =
- if translate_group(source,n) is
- {
- three_bytes(n1,b1,b2,b3) then
- forget(put(target,m,b1));
- forget(put(target,m+1,b2));
- forget(put(target,m+2,b3));
- translate_groups(source,n1,target,m+3),
-
- two_bytes(b1,b2) then
- forget(put(target,m,b1));
- forget(put(target,m+1,b2));
- m+2,
-
- one_byte(b1) then
- forget(put(target,m,b1));
- m+1,
-
- zero_bytes then
- m,
-
- error then
- m
- }.
-
-
-define ByteArray
- wa64_decode
- (
- ByteArray ba
- ) =
- with l = length(ba),
- result = constant_byte_array(l,'0'),
- truncate(result,translate_groups(ba,0,result,0));
- result.
-
-public define Maybe($T)
- web_arg_decode
- (
- String encoded_datum
- ) =
- (Maybe($T))unserialize(wa64_decode(to_byte_array(encoded_datum))).
-
-
-
-
-
+
+ *Project* The Anubis Project
+
+ *Title* Encoding data for web argument values.
+
+ *Copyright* Copyright (c) Alain Prouté 2002.
+
+
+ *Author* Alain Prouté
+
+
+
+ *Overview*
+ This file contains encoding and decoding functions which allow to put any serializable
+ datum as the value of a web argument. The datum is serialized, and the result of
+ serialization (a byte array) is encoded in such a way that it can safely be used as the
+ value of a web argument. The encoding process is similar to the standard process
+ 'base64', but nevertheless different, because base64 is not suitable for that purpose.
+
+
+public define String
+ web_arg_encode
+ (
+ $T datum
+ ).
+
+public define Maybe($T)
+ web_arg_decode
+ (
+ String encoded_value
+ ).
+
+ Of course, since the type of the datum is not available from 'encoded_value', a term
+ like 'web_arg_decode(my_string)' must generally be explicitly typed, like this:
+
+ (Maybe(MyType))web_arg_decode(my_string)
+
+
+ These functions are used for example in 'anubis/library/web/kernel.anubis'.
+
+
+
+
+
+ --- That's all for the public part. ---------------------------------------------------
+
+read tools/basis.anubis
+
+ Our algorithms are copy-pasted from 'base64.anubis' and slightly modified. The point is
+ twofold:
+
+ (1) base64 encoding inserts carriage return (CR) and line feed (LF) characters every
+ 76 character, but CR and LF are not suitable in the values of a web argument,
+
+ (2) the base64 alphabet uses '+' and '/', which are also not suitable in the value of
+ a web argument, because they have special meanings.
+
+ Hence, we just have to modify the base64 algorithms, so as not to generate any CR or
+ LF, and use '-' and '_' instead of '+' and '/'. Also, we do not use padding characters
+ '=', which are needless (as remarked in 'anubis/library/tools/base64.anubis').
+
+
+
+ *** Encoding. *************************************************************************
+
+ Translate an index into a wa64 character.
+
+define Word8
+ wa64_alphabet
+ (
+ Int32 index // the index is assumed to be >= 0 and < 64
+ ) =
+ if index < 0 then print("Bad index [" + index + "] in wa64_alphabet()\n"); '_' else
+ if index < 26 then truncate_to_word8(index+'A') else
+ if index < 52 then truncate_to_word8(index-26+'a') else
+ if index < 62 then truncate_to_word8(index-52+'0') else
+ if index = 62 then '-' else
+ if index = 63 then '_' else
+ print("Bad index [" + index + "] in wa64_alphabet()\n"); '_'.
+
+
+
+ Transform a group of 3 bytes into a group of 4 wa64 letters.
+
+define (Word8,Word8,Word8,Word8)
+ transform_group
+ (
+ Word8 byte1,
+ Word8 byte2,
+ Word8 byte3
+ ) =
+ with n1 = word8_to_int32(byte1),
+ n2 = word8_to_int32(byte2),
+ n3 = word8_to_int32(byte3),
+ (
+ wa64_alphabet(n1>>2),
+ wa64_alphabet(((n1&3)<<4)|(n2>>4)),
+ wa64_alphabet(((n2&15)<<2)|(n3>>6)),
+ wa64_alphabet(n3&63)
+ ).
+
+
+ Transform a group of two bytes.
+
+define ByteArray
+ two_mod_three
+ (
+ ByteArray result,
+ Int32 result_index,
+ Word8 byte1,
+ Word8 byte2
+ ) =
+ with n1 = word8_to_int32(byte1),
+ n2 = word8_to_int32(byte2),
+ forget(put(result,result_index ,wa64_alphabet(n1>>2)));
+ forget(put(result,result_index+1,wa64_alphabet(((n1&3)<<4)|(n2>>4))));
+ forget(put(result,result_index+2,wa64_alphabet((n2&15)<<2)));
+ forget(put(result,result_index+4,0));
+ result.
+
+
+
+ Transform a 'group of one byte'.
+
+define ByteArray
+ one_mod_three
+ (
+ ByteArray result,
+ Int32 result_index,
+ Word8 byte1
+ ) =
+ with n1 = word8_to_int32(byte1),
+ forget(put(result,result_index ,wa64_alphabet(n1>>2)));
+ forget(put(result,result_index+1,wa64_alphabet((n1&3)<<4)));
+ forget(put(result,result_index+4,0));
+ result.
+
+
+
+define ByteArray
+ wa64_encode
+ (
+ ByteArray ba,
+ Int32 ba_index, // index into byte array
+ ByteArray result,
+ Int32 result_index
+ ) =
+ if nth(ba_index,ba) is
+ {
+ failure then forget(put(result,result_index,0)); result, // no new block of 3 bytes
+ success(byte1) then
+ if nth(ba_index+1,ba) is
+ {
+ failure then one_mod_three(result,result_index,byte1),
+ success(byte2) then
+ if nth(ba_index+2,ba) is
+ {
+ failure then two_mod_three(result,result_index,byte1,byte2),
+ success(byte3) then
+ if transform_group(byte1,byte2,byte3) is (c1,c2,c3,c4) then
+ (
+ forget(put(result,result_index,c1));
+ forget(put(result,result_index+1,c2));
+ forget(put(result,result_index+2,c3));
+ forget(put(result,result_index+3,c4));
+ wa64_encode(ba,
+ ba_index+3,
+ result,
+ result_index+4)
+ )
+ }
+ }
+ }.
+
+
+
+define ByteArray
+ wa64_encode
+ (
+ ByteArray ba
+ ) =
+ with l = length(ba),
+ wa64_encode(ba,0,
+ constant_byte_array((((l/57)+1)*76)+10,0),0).
+
+
+public define String
+ web_arg_encode
+ (
+ $T datum
+ ) =
+ to_string(wa64_encode(serialize(datum))).
+
+
+
+
+
+ *** Decoding. *************************************************************************
+
+ See the comments in 'anubis/library/tools/base64.anubis'.
+
+ Checking if a character belongs to the wa64 alphabet. If true, the function returns the
+ index of the character in the alphabet.
+
+define Maybe(Int32)
+ is_wa64_char
+ (
+ Word8 c
+ ) =
+ with n = word8_to_int32(c),
+ if ('A' =< n & n =< 'Z') then success(n - 'A') else
+ if ('a' =< n & n =< 'z') then success(n - 'a' + 26) else
+ if ('0' =< n & n =< '9') then success(n - '0' + 52) else
+ if n = '-' then success(62) else
+ if n = '_' then success(63) else
+ failure.
+
+
+
+ Getting the next wa64 character from the input. The function returns the next position
+ for reading. The function does not return the character itself, but its index in the
+ alphabet.
+
+define Maybe((Int32, // next position for reading
+ Int32)) // index of character in wa64 alphabet
+ get_next_character
+ (
+ ByteArray ba,
+ Int32 n
+ ) =
+ if nth(n,ba) is
+ {
+ failure then failure,
+ success(c) then
+ if is_wa64_char(c) is
+ {
+ failure then failure,
+ success(i) then success((n+1,i))
+ }
+ }.
+
+
+ Translating a group of characters into a group of bytes.
+
+type TranslateGroupResult:
+ three_bytes (Int32 new_pos, Word8 b1, Word8 b2, Word8 b3),
+ two_bytes ( Word8 b1, Word8 b2 ),
+ one_byte ( Word8 b1 ),
+ zero_bytes,
+ error.
+
+
+define TranslateGroupResult
+ translate_group
+ (
+ ByteArray ba,
+ Int32 n
+ ) =
+ if get_next_character(ba,n) is
+ {
+ failure then zero_bytes,
+ success(p1) then if p1 is (n1,i1) then
+ if get_next_character(ba,n1) is
+ {
+ failure then error,
+ success(p2) then if p2 is (n2,i2) then
+ if get_next_character(ba,n2) is
+ {
+ failure then // we don't check the padding characters
+ one_byte(truncate_to_word8((i1<<2)|(i2>>4))),
+ success(p3) then if p3 is (n3,i3) then
+ if get_next_character(ba,n3) is
+ {
+ failure then
+ two_bytes(truncate_to_word8((i1<<2)|(i2>>4)),
+ truncate_to_word8(((i2&15)<<4)|(i3>>2))),
+ success(p4) then if p4 is (n4,i4) then
+ three_bytes(n4,truncate_to_word8((i1<<2)|(i2>>4)),
+ truncate_to_word8(((i2&15)<<4)|(i3>>2)),
+ truncate_to_word8(((i3&3)<<6)|i4))
+ }
+ }
+ }
+ }.
+
+
+define Int32 // returns the size of the decoded array of bytes
+ translate_groups
+ (
+ ByteArray source,
+ Int32 n, // position in source
+ ByteArray target,
+ Int32 m // position in target
+ ) =
+ if translate_group(source,n) is
+ {
+ three_bytes(n1,b1,b2,b3) then
+ forget(put(target,m,b1));
+ forget(put(target,m+1,b2));
+ forget(put(target,m+2,b3));
+ translate_groups(source,n1,target,m+3),
+
+ two_bytes(b1,b2) then
+ forget(put(target,m,b1));
+ forget(put(target,m+1,b2));
+ m+2,
+
+ one_byte(b1) then
+ forget(put(target,m,b1));
+ m+1,
+
+ zero_bytes then
+ m,
+
+ error then
+ m
+ }.
+
+
+define ByteArray
+ wa64_decode
+ (
+ ByteArray ba
+ ) =
+ with l = length(ba),
+ result = constant_byte_array(l,'0'),
+ truncate(result,translate_groups(ba,0,result,0));
+ result.
+
+public define Maybe($T)
+ web_arg_decode
+ (
+ String encoded_datum
+ ) =
+ (Maybe($T))unserialize(wa64_decode(to_byte_array(encoded_datum))).
+
+
+
+
+
--
libgit2 0.21.4