*Project* The Anubis Project
*Title* A Multi Host HTTP/HTTPS Server
*Copyright* Copyright © Anubis Team 2003-2007.
© Calexium 2007-2013
© David René 2014-2019
*Authors* Alain Prouté
David René
Cédric Ricard
*Revised*
June 2015 : Optimization of the file upload
July 2007 : Initial version in xlib
March 2019 : move as standard lib
*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.
*** (10) HTTP Errors
---------------------------------------------------------------------------------------
*** (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 xlib/web/common.anubis
read tools/basis.anubis
read tools/printable_tree.anubis
read system/string.anubis
read system/files.anubis
read system/lists.anubis
read system/data_io.anubis
read system/logger.anubis
read web/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.
Each site is described by a 'web site description', which is a datum of type
'Web_Site_Description'.
public type Content_Disposition:
inline,
attachment.
public define String
to_String
(
Content_Disposition c_disposition
)=
if c_disposition is
{
inline then "inline",
attachment then "attachment"
}
.
public define Content_Disposition
to_Content_Disposition
(
String disposition_string
)=
if disposition_string = "attachment" then attachment
else if disposition_string = "inline" then inline
else
inline
.
public type AWP_Handler_Answer:
printable_tree(Printable_tree p_tree),
send_file(String full_path, Content_Disposition c_disposition)
.
public type Web_Site_Description:
web_site_description(
List(String) common_names,
String site_directory,
Redirections redirections,
String charset,
List(String) journal_extensions,
List(String) journal_headers,
(LogLevel, String) -> One logger, //logger
String authorization_secret,
List(MIME) known_mime_types,
(String host_name,
HTTP_Info http_info,
List(Web_arg) lwa,
Bool is_https) -> AWP_Handler_Answer awp_handler,
List(HTTP_header) constant_additional_headers,
(HTTP_Info http_info,
List(Web_arg) lwa) -> One before_send_file
//Bool using_state_cookies,
).
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 (Word32 address,
Int last_activity).
public type DenialOfService:
denial_of_service(Var(Int) max_connections,
Var(Int) request_line_delay, // seconds
Var(Int) headers_delay,
Var(Int) answer_delay,
Var(List(DubiousIP)) list_of_dubious,
Var(List(Word32)) 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
(
Word32 ip_address,
Word32 http_port,
List(Web_Site_Description) web_sites
//DenialOfService dos
).
public define StartServerResult
start_https_server
(
Word32 ip_address,
Word32 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,
Word32 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
(
Word32 ip_address, // address for listening (typically 0)
Word32 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
).
*** (10) HTTP Errors
public type HTTP_Status:
http_continue, // 100
http_switching_protocol, // 101
http_ok, // 200
http_created, // 201
http_accepted, // 202
http_non_authoritative_info, // 203
http_no_content, // 204
http_reset_content, // 205
http_partial_content, // 206
http_multiple_choices,
http_moved_permanently(String location), // 301
http_moved_temporarily(String location), // 302
http_see_other(String location), // 303
http_not_modified, // 304
http_use_proxy(String location), // 305
http_temporary_redirect(String location), // 307
http_bad_request, // 400
http_unauthorized, // 401
http_payment_required, // 402
http_forbidden, // 403
http_not_found, // 404
http_method_not_allowed, // 405
http_not_acceptable, // 406
http_proxy_authentification_required, // 407
http_request_timeout, // 408
http_conflict, // 409
http_gone, // 410
http_length_required, // 411
http_precondition_failed, // 412
http_request_entity_too_large, // 413
http_request_uri_too_long, // 414
http_unsupported_media_type, // 415
http_request_range_unsatisfiable, // 416
http_expectation_failed, // 417
http_internal_server_error, // 500
http_not_implemented, // 501
http_bad_gateway, // 502
http_service_unavailable, // 503
http_gateway_timeout, // 504
http_version_not_supported, // 505
http_error(Int /*code*/, String /*message*/).
public define (String, List(HTTP_header))
format
(
HTTP_Status status
).
--- That's all for the public part ! --------------------------------------------------
define Maybe(String) get_host_header_value(List(HTTP_header) headers).
define String
__utime_to_string
(
UTime t
) =
to_decimal(t.seconds) + "." + zero_pad_n(6, t.microseconds ) + "s".
variable UTime t0 = utime(0,0).
variable UTime t1 = utime(0,0).
define One
accumulate_t1
(
UTime start
) =
with delta = (UTime)unow - start,
t1 <- delta + *t1;
unique.
variable UTime t2 = utime(0,0).
define One
accumulate_t2
(
UTime start
) =
with delta = (UTime)unow - start,
t2 <- delta + *t2;
unique.
public define One
print_delta
(
String txt
) =
println(__utime_to_string((UTime)unow - *t0) + " : " + txt).
----------------------------------- 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(Int).
type HTTP_Request_Method:
options,
get,
head,
post,
put,
delete,
trace,
connect,
extension(String)
.
type HTTP_Request_Line:
request_line(
HTTP_Request_Method method,
String uri,
List(Web_arg) query_string).
type EncodingType:
www_url,
multipart_form_data.
public type HTTP_Buffered_Connection:
http_buffered_connection(
Connection conn,
Var(ByteArray) buffer,
Var(Int) read_pos,
Var(List(Word8)) unput_chars // for reading requests
).
public define HTTP_Buffered_Connection
http_buffered_connection
(
Connection conn
)=
http_buffered_connection(conn, var(constant_byte_array(0, 0)), var(0), var([]))
.
*** [2] Tools.
*** [2.1] Formating an error message.
The next function formats an error message.
public 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) --> Word32 ip_address
Word32 --> String ip_addr_to_string
These conversions are defined in 'tools/basis.anubis'.
*** [2.3] A set of state variables for the server.
public type SState:
sstate
(
//Var(List(Word8)) unput_chars, // for reading requests
Var(Int) sttm, // 'start time'
Var(Int) uploaded_file_count
).
*** [2.4] 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,
HTTP_Buffered_Connection s
) =
s.unput_chars <- (List(Word8))[character . *(s.unput_chars)].
define One record_dubious_IP(Word32 addr,DenialOfService dos).
variable Int sttm = 0. // contains the start time for this connection.
define Result(Error,Word8)
record_dubious_connection
(
Connection conn,
Int dead_line,
DenialOfService dos,
SState s
) =
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-*(s.sttm))+" seconds. Total: "+
length(*list_of_dubious(dos))+"\n");
error(timeout(dead_line)).
define String
pid
=
"[" + virtual_machine_id + "] ".
define One
put
(
ByteArray source,
ByteArray dest,
Int position,
Int i
) =
if nth(i,source) is
{
failure then unique,
success(b) then if put(dest,position,b) is
{
failure then unique,
success(_) then put(source,dest,position+1,i+1)
}
}.
define Maybe(ByteArray)
read_from_connexion
(
HTTP_Buffered_Connection connection, //connection to read
Int size_to_read, //size to read
Int time_out, //time out
ByteArray result_buffer //the current read bytes
) =
//println(pid + "read_from_connexion(" + size_to_read + ", "+time_out+")");
//println(pid + "connection buffer ["+length(*connection.buffer)+"]["+*connection.read_pos+"]["+to_string(*connection.buffer)+"]");
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_to_read),
size_read = length(result),
//put(result, result_buffer, position, 0);
//println(pid + "read size ["+size_read+"]["+to_string(result)+"]");
//println(pid + "result_buffer size ["+length(result_buffer)+"]["+to_string(result_buffer)+"]");
with current_result_buffer = result_buffer + result,
//println(pid + "current_result_buffer size ["+length(current_result_buffer)+"]["+to_string(current_result_buffer)+"]");
//println(pid + "connection.read_pos "+*connection.read_pos+" + read_size ["+size_read+"]");
connection.read_pos <- *connection.read_pos + size_read;
//println(pid + "new connection.read_pos["+*connection.read_pos+"]");
//accumulate_t1(t1_tmp);
if size_to_read > size_read then
terminal read_from_connexion(connection, size_to_read - size_read, time_out, current_result_buffer)
// {
// error then error,
// timeout then ok(result),
// ok(ba) then ok(result + ba)
// }
else
// println(pid + "success: ["+length(current_result_buffer)+"]");
// println(pid + "content: ["+to_string(current_result_buffer)+"]");
success(current_result_buffer)
else
//with t0 = (UTime) unow,
//if unow > dead_line then record_dubious_connection(connection,dead_line,dos) else
println(pid +"try to read fill buffer with 32768 bytes time out ["+time_out+"]");
if read(connection.conn, 32768, time_out) is // read with timeout
{
failure then println(pid + "read failed ["+to_string(result_buffer)+"] connection maybe lost"); failure,
success(ba) then
with size_read = length(ba),
println( pid + "read ["+size_read+"] bytes");
//the needed read is higher than the
if size_read = 0 then
read_from_connexion(connection, size_to_read, time_out, result_buffer)
else if size_to_read > size_read then
//put(ba, result_buffer, position, 0);
with current_result_buffer = result_buffer + ba,
read_from_connexion(connection, size_to_read - size_read, time_out, current_result_buffer)
else
//println(pid + "ba = " + length(ba) + " duration: " + __utime_to_string((UTime) unow - t0));
connection.buffer <- ba;
connection.read_pos <- 0;
//println(pid + "rb = " + length(*read_buffer));
terminal read_from_connexion(connection, size_to_read, time_out, result_buffer)
}
.
define Maybe(ByteArray)
read_from_connexion
(
HTTP_Buffered_Connection connection, //connection to read
Int size_to_read, //size to read
Int time_out //time out
)=
read_from_connexion(connection, size_to_read, time_out, constant_byte_array(0,0))
.
define Result(Error,Word8)
next_char // reading a character (check the list first, and read on the connection
// only when the list is empty).
(
HTTP_Buffered_Connection connection
// Int dead_line,
// DenialOfService dos
) =
//with t2_tmp = (UTime) now,
if *(connection.unput_chars) is
{
[ ] then
// ///////////////////
// Buffered reading
//if unow > dead_line then record_dubious_connection(connection,dead_line,dos) else
if nth(*connection.read_pos, *connection.buffer) is
{
failure then
if read_from_connexion(connection, 1, 600 /*, constant_byte_array(1,0),0*/) is
{
failure then /*accumulate_t2(t2_tmp);*/ error(cannot_read_from_connection),
//record_dubious_connection(connection,dead_line,dos),
success(ba) then if nth(0,ba) is
{
failure then /*accumulate_t2(t2_tmp);*/ error(cannot_read_from_connection),
success(c) then
//println("-" + pid + "read [" + implode([c]) + "]\t");
//accumulate_t2(t2_tmp);
ok(c)
}
},
success(c) then
connection.read_pos <- *connection.read_pos + 1;
//println(pid + "read [" + implode([c]) + "] \t new pos ["+*connection.read_pos+"]");
//accumulate_t2(t2_tmp);
ok(c)
},
// ///////////////////
// standard reading
// if read(connection.conn, 1, 600) is // the connection is closed after 10 minutes of inactivity
// {
// error then accumulate_t2(t2_tmp); println(pid + "read failed)"); error(cannot_read_from_connection),
// timeout then accumulate_t2(t2_tmp); error(timeout(600)),
// ok(ba) then if nth(0,ba) is
// {
// failure then accumulate_t2(t2_tmp); error(cannot_read_from_connection),
// success(c) then accumulate_t2(t2_tmp);
// ok(c)
// }
// },
[h . t] then
connection.unput_chars <- t; //accumulate_t2(t2_tmp);
ok(h)
}.
define ByteArray
get_and_erase_buffer
(
HTTP_Buffered_Connection connection
)=
with head = to_byte_array(implode(*connection.unput_chars)),
tail = extract(*connection.buffer, *connection.read_pos, length(*connection.buffer)),
// println("--- get_and_erase_buffer ----");
// println("unput char length : "+length(to_string(head)));
// println("connection.read_pos : "+*connection.read_pos);
// println("connection.buffer length : "+length(*connection.buffer));
// println(" tail length : "+length(tail));
// println(" -- unputchar content ");
// println("["+to_string(head)+"]");
// println(" -- buffer content ");
// println("["+to_string(*connection.buffer)+"]");
// println(" -- tail content ");
// println("["+to_string(tail)+"]");
connection.unput_chars <- [];
connection.buffer <- constant_byte_array(0,0);
connection.read_pos <- 0;
head + tail
.
*** [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
(
HTTP_Buffered_Connection connection, // to client
Int number_of_characters // number of characters to read and ignore
) =
if number_of_characters =< 0 then
ok(unique)
else
if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then read_and_ignore(connection, number_of_characters-1)
}.
*** [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
(
HTTP_Buffered_Connection connection, // connection with the client
List(Word8) so_far // characters read so far (in reverse order)
) =
if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then
if c = '\\'
then if next_char(connection) is
{
error(msg) then error(msg),
ok(d) then
if d = '\"'
then read_string(connection,['\"' . so_far])
else read_string(connection,[d, c . so_far])
}
else if c = '\"'
then ok(implode(reverse(so_far)))
else read_string(connection,[c . so_far])
}.
*** [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 n1 = if x1 +=< '9' then (x1 - '0') else if x1 +=< 'F' then (x1 - 'A' + 10) else (x1 - 'a' + 10),
n2 = if x2 +=< '9' then (x2 - '0') else if x2 +=< 'F' then (x2 - 'A' + 10) else (x2 - 'a' + 10),
(n1 << 4) + n2.
define String
web_to_ascii
(
String web_string,
Int 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
//println("=== % ===");
if nth(n+1, web_string) is
{
failure then implode(reverse(so_far)),
success(x1) then
//println("=== % 1 === ["+x1+"]");
if nth(n+2, web_string) is
{
failure then implode(reverse(so_far)),
success(x2) then
//println("=== % 2 === ["+x2+"]");
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
to_decimal(y)+"_"+
zero_pad_n(2,m)+"_"+
zero_pad_n(2,d)+"_"+
zero_pad_n(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
(
Int 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_Request_Line 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
to_decimal(year(dt))+"/"+format_month(month(dt))+"/"+zero_pad_n(2,day(dt))+" "+
zero_pad_n(2,hour(dt))+":"+zero_pad_n(2,minute(dt))+":"+zero_pad_n(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 ba_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),ba_msg))
}
//forget(reliable_write(file(stdout),ba_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
(
HTTP_Buffered_Connection connection
)
=
if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then
if is_strict_blank(c)
then skip_http_blanks(connection)
else if c = 13
then if next_char(connection) is
{
error(msg) then error(msg), // (unput(c); ok(unique)),
ok(d) then
if d = 10
then if next_char(connection) 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)
else (unput(e, connection); unput(d, connection); unput(c, connection); ok(unique))
}
else (unput(d, connection); unput(c, connection); ok(unique))
}
else (unput(c, connection); 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.
public define Result(Error,One)
read_new_line
(
HTTP_Buffered_Connection connection
) =
if skip_http_blanks(connection) is
{
error(msg) then error(msg),
ok(_) then
if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then
if c = 13
then if next_char(connection) is
{
error(msg) then error(msg),
ok(d) then
if d = 10
then ok(unique)
else (unput(d, connection);
unput(c, connection);
println("1");
error(end_of_line_expected))
}
else (unput(c, connection);
println("2");
error(end_of_line_expected))
}}.
public define Result(Error,One)
skip_line
(
HTTP_Buffered_Connection connection
) =
if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then
if c = 13 then
if next_char(connection) is
{
error(msg) then error(msg),
ok(d) then
if d = 10 then
ok(unique)
else
skip_line(connection)
}
else
skip_line(connection)
}.
*** [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
(
HTTP_Buffered_Connection connection,
List(Word8) so_far
) =
if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then
if is_blank(c)
then (unput(c, connection);
ok(implode(reverse(so_far))))
else read_word_aux(connection,[c . so_far])
}.
define Result(Error,String)
read_word
(
HTTP_Buffered_Connection connection
) =
if skip_http_blanks(connection) is
{
error(msg) then error(msg),
ok(_) then
if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then
if c = '\"'
then read_string(connection,[])
else read_word_aux(connection,[c])
}
}.
*** [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,
Int 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,
Int start,
Int 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)
}
.
public define List(Web_arg)
read_www_url_encoded_web_args
(
String s, //url_encoded string
Int start //current position in string
) =
with first = read_name_or_value(s, start, start),
with name = web_to_ascii(first, 0, []),
if first = "" then
[]
else
with i = start + length(first), //jump to end of first word
if nth(i,s) is
{
failure then
//println("failure name=["+name+"]");
[web_arg(name, "")],
success(c) then
if c = '&' then
//println("& alone name=["+name+"]");
[web_arg(name, "") . read_www_url_encoded_web_args(s,i+1)]
else if c = '=' then
with second = read_name_or_value(s, i+1, i+1),
//print("\""+second+"\"\n");
with value = web_to_ascii(second, 0, []),
//println("first ["+first+"] => name ["+name+"] second ["+second+"] => value ["+value+"]");
//println("name ["+name+"] => value ["+value+"]");
//here check the name starting with amp; which means it was "&" encoded and it must be removed
with _name = if substr(name, 0, 4) = "amp;" then substr(name, 4, length(name) - 4) else name,
[web_arg(_name, value) . read_www_url_encoded_web_args(s, i+length(second)+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_Request_Method)
identify_get_or_post
(
String s
)=
with ls = to_lower(s),
if ls = "get" then ok(get) else
if ls = "post" then ok(post) else
error(not_get_or_post_request(ls)).
public define Result(Error, HTTP_Request_Line)
read_request_line
(
HTTP_Buffered_Connection connection
) =
//Read the Method
if read_word(connection) is
{
error(msg) then error(msg),
ok(method) then
//read the URI
if read_word(connection) is
{
error(msg) then error(msg),
ok(uri_and_query_string) then
//Read the HTTP version
if read_word(connection) is
{
error(msg) then error(msg),
ok(http_version) then
//read the ending CR/LF
if read_new_line(connection) 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(method) is
{
error(msg) then error(msg),
ok(request_type) then ok(request_line(request_type, web_to_ascii(uri, 0, []), 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
) =
if ('a' +=< c & c +=< 'z') then true else
if ('A' +=< c & c +=< 'Z') then true else
if ('0' +=< c & c +=< '9') then true else
if c = '-' then true else
c = '_'.
define Result(Error,String)
read_header_name
(
HTTP_Buffered_Connection connection,
List(Word8) so_far
) =
if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then
if is_header_name_char(c)
then read_header_name(connection, [to_lower(c) . so_far])
else unput(c, connection); ok(implode(reverse(so_far)))
}.
define Result(Error,One)
skip_colon
(
HTTP_Buffered_Connection connection
) =
//Skip the blank char until ':'
if skip_http_blanks(connection) is
{
error(msg) then error(msg),
ok(_) then
if next_char(connection) 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
(
HTTP_Buffered_Connection connection,
List(Word8) so_far
) =
if next_char(connection) is
{
error(msg) then error(msg),
ok(c) then
if c = 13
then if next_char(connection) is
{
error(msg) then error(msg),
ok(d) then
if d = 10
then if next_char(connection) is
{
error(msg) then error(msg),
ok(e) then
if is_strict_blank(e)
then read_header_value(connection, [e . so_far])
else (unput(e, connection); ok(implode(reverse(so_far))))
}
else read_header_value(connection,[d, c . so_far])
}
else read_header_value(connection,[c . so_far])
}.
Reading a single header.
define Result(Error,Maybe(HTTP_header))
read_header
(
HTTP_Buffered_Connection connection
) =
//Find the name
if read_header_name(connection, []) is
{
error(msg) then error(msg),
ok(name) then
if name = "" then
if read_and_ignore(connection, 2) /* 13 and 10 */ is
{
error(msg) then error(msg),
ok(_) then // this is the blank line
ok(failure) // end of headers
}
//skip the ':' and blank before and after it
else if skip_colon(connection) is
{
error(msg) then error(msg),
ok(_) then
//skip the blank char after the ':'
if skip_http_blanks(connection) is
{
error(msg) then error(msg),
ok(_) then
//Now read the value
if read_header_value(connection, []) is
{
error(msg) then error(msg),
ok(value) then ok(success(http_header(name,value)))
}
}
}
}.
Reading all the headers.
public define Result(Error,List(HTTP_header))
read_http_headers
(
HTTP_Buffered_Connection connection
) =
if read_header(connection) is
{
error(msg) then error(msg),
ok(mbh) then if mbh is
{
failure then ok([ ]),
success(header) then
if read_http_headers(connection) 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.
public define Result(Error,Int)
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 decimal_scan(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.
public define Result(Error, ByteArray)
read_http_body
(
HTTP_Buffered_Connection connection,
Int body_size,
ByteArray so_far, // when calling this function, 'so_far' is the empty byte array
Int 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_from_connexion(connection, body_size, 600 /*,constant_byte_array(body_size,0),0*/) is
{
failure then error(cannot_read_from_connection),
success(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 then // must read more bytes
if nn > 0 then // if connection seems to work
println("http body ("+body_size+") read "+nn+" bytes current size "+nr+" Bytes");
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,retries-1) // and retry reading 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
) =
if ('a' +=< c & c +=< 'z') then true else // accept 'a' to 'z'
if ('A' +=< c & c +=< 'Z') then true else // accept 'A' to 'Z'
if ('0' +=< c & c +=< '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,
Int 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,
Int 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
public define Bool
contains_no_case
(
List(String) l,
String val
) =
if l is
{
[] then false,
[h . t] then
if insensitive_equal(h, val) then true
else contains_no_case(t, val)
}.
define Maybe(MIME)
recognize_mime_type_from_ext
(
String ext,
List(MIME) l
) =
if l is
{
[ ] then success(mime("application", "octet-stream", [])), // failure,
[h . t] then if h is mime(type, subtype, extensions) then
if contains_no_case(extensions, ext)
then success(h)
else recognize_mime_type_from_ext(ext,t)
}.
define Maybe(MIME)
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).
public 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
(
Int 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
(
MIME mime_type,
String filename,
Int size,
String etag,
Maybe(FileTimes) mb_ftimes,
Content_Disposition c_disposition
)=
with headers = (List(HTTP_header))
[
http_header("Content-Type", to_String(mime_type)),
http_header("Etag", "\""+etag+"\""),
http_header("Cache-Control", "max-age=600"),
http_header("Content-Length",to_decimal(size)),
http_header("Content-Disposition", to_String(c_disposition)+"; filename=\"" + filename +"\"")
],
if mb_ftimes is
{
failure then headers,
success(ftimes) then [http_header("Last-Modified", format_http_date(to_Int(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
Int size, // size of file
Int sent, // bytes already sent
String filename // name of file
) =
if sent >= size then
//TODO add call back on success if need
unique
else if read(file,min(65536,size-sent),60) is
{
failure then log_journal_msg(desc,"Cannot read from file '"+filename+"'.\n"),
success(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 delirering '"+filename+"' (sent="+sent+"; size="+size+"; current="+nr+").\n"),
success(nw) then send_file_body(desc,connection,file,size,sent+nw,filename)
}
}
.
define String
compute_etag
(
String filename,
Maybe(FileTimes) mb_ftimes,
Int 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(md5((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 trim_token(etag, '\"') = current_etag //remove triming " because this is quoted string
}.
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,
Int size, // size of the file to send
Connection file, // file to be sent already opened
String filename, // name of file
String full_path, // full path to the file (filename included)
MIME mime_type, // mime type of the file
Content_Disposition c_disposition, // content disposition (inline, attachment)
One -> One action_before_send_file //call to execute before sending 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, filename, size, current_etag, mb_ftimes, c_disposition)) , crlf]));
//forget(copy_file_to_Connection(file, connection, size)),
send_file_body(desc,connection,file,size,0,filename),
true then
with updated_header =
[
http_header("Cache-Control", "max-age=600"),
http_header("Content-length","0"),
http_header("Etag", "\""+current_etag+"\"")
] + headers,
forget(reliable_write(connection,to_byte_array("HTTP/1.1 304 Not Modified"+crlf)));
forget(reliable_write(connection,[format_headers(updated_header) , 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,
Content_Disposition c_disposition,
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))file(path, read) is
{
failure then
println("HTTP/1.1 404 Not Found"+path);
forget(reliable_write(connection,to_byte_array("HTTP/1.1 404 Not Found"+crlf+
"Content-Length: 0"+crlf+crlf
/*+"Connection: close"+crlf+crlf*/)));
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,
c_disposition,
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))file(absolute_path, read) is
{
failure then
println("HTTP/1.1 404 Not Found"+absolute_path);
forget(reliable_write(connection,to_byte_array("HTTP/1.1 404 Not Found"+crlf+
"Content-Length: 0"+crlf+crlf
)));
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 mime("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,
c_disposition,
action_before_send_file)
}
)
else log_journal_msg(desc,"Cannot find or read authorization file.\n")
}.
define One
send_file_answer
(
Web_Site_Description desc,
Connection connection,
String uri,
String absolute_path,
Content_Disposition c_disposition,
List(HTTP_header) input_headers,
List(HTTP_header) output_headers,
One -> One action_before_send_file
)=
if (Maybe(RStream))file(absolute_path, read) is
{
failure then
println("HTTP/1.1 404 Not Found"+absolute_path);
forget(reliable_write(connection,to_byte_array("HTTP/1.1 404 Not Found"+crlf+
"Content-Length: 0"+crlf+crlf
/*+"Connection: close"+crlf+crlf*/)));
log_journal_msg(desc,"Cannot find file '"+absolute_path+"'.\n"),
success(f) then
with size = file_size(f),
since split_filename_extension(absolute_path) is (filename, extension),
with mime_type = get_MIME_from_extension("."+extension),
//println("send file answer: "+filename+" ext: "+extension+ " uri :" +uri);
send_file(
desc,
connection,
input_headers,
output_headers,
size,
file(f),
filename+"."+extension,
absolute_path,
mime_type,
c_disposition,
action_before_send_file
)
}
.
*** [5.6] Answering a www-url encoded request.
Standard headers are for answering ".awp" requests.
public define List(HTTP_header)
standard_headers
=
[
http_header("Date", format_http_date(now)),
http_header("Server", "Anubis Embedded Web Server v" + major_version_number + "." + minor_version_number),
/*http_header("Connection", "close"), */
].
public define List(HTTP_header)
standard_headers_for
(
String mime_type,
Int answer_body_size,
Maybe(String) mb_charset,
) =
[
http_header("Content-Type", mime_type + if mb_charset is success(charset) then "; charset="+charset else ""),
http_header("Content-length", to_decimal(answer_body_size))
].
public define List(HTTP_header)
file_attached_header
(
String filename
) =
[
http_header("Content-Disposition", "attachment; filename=\"" + filename +"\"")
].
define One
www_url_answer
(
String host_name,
Web_Site_Description desc,
Connection connection, // with the client
Word32 ip_addr, // of the client
HTTP_Request_Line 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),
http_inf = http_info(ip_addr, host_name, uri, headers, is_SSL(connection)),
(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
if desc.awp_handler(host_name, http_inf, all_web_args, is_SSL(connection)) is
{
printable_tree(answer_headers_body) then
forget(reliable_write(connection, answer_headers_body)),
send_file(file_path, content_disposition) then
send_file_answer(desc, connection, uri, file_path, content_disposition, headers, standard_headers + constant_additional_headers(desc),
(One u) |-> before_send_file(desc)(http_inf, all_web_args))
}
else (send_file(desc,
connection,
uri,
headers,
standard_headers + constant_additional_headers(desc),
if web_arg_value(all_web_args,"zauth") is
{
not_found then failure,
found(v) then success(v)
},
inline,
(One u) |-> before_send_file(desc)(http_inf, all_web_args))
//print_delta("After sending file")
)).
*** [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,
Int 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,
Int 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 '= ...'
Int 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(Int)
find
(
String what,
ByteArray where,
Int start,
Int 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 Maybe(Int)
find
(
String what,
String where,
Int start,
Int end
) =
if find_string(where,what,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,
Int start,
Int 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,
Int start,
Int end
) =
with prefix = name+"=\"",
if find(to_byte_array(prefix),where,start) is
{
failure then failure,
success(n) then
if n+length(prefix) >= end
then failure
else success(read_attribute_value(where,n+length(prefix),end,[]))
}.
define Maybe((String,Maybe(String)))
find_name_and_filename
(
ByteArray body,
Int start,
Int 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 Int 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
(
String web_site_dir,
// Web_Site_Description desc,
RStream body_fd,
// ByteArray body,
Int start,
Int end,
SState s
) =
s.uploaded_file_count <- 1 + *(s.uploaded_file_count);
with tfn = "_"+to_decimal(virtual_machine_id)+"_"+to_decimal(*(s.uploaded_file_count)),
// println("save_uploaded_file to :"+site_directory(desc)+"/upload_temporary/"+tfn);
// println("start offset = "+start+" end offset = "+end);
//make data_io which is the size of the file to extract
if copy_Data_IO_to_file(make_data_io(body_fd, start, end - start), web_site_dir+"/upload_temporary/"+tfn) is copy_ok(_)
then success(tfn)
else failure
.
// if (Maybe(RWStream))file(site_directory(desc)+"/upload_temporary/"+tfn, new) 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 Int
file_name_begin
(
String full_name,
Int 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,
String web_site_dir,
String body_temp_file,
Int start_offset, //real offset in source file of the part
Int end_offset, //real offset in source file of the part
SState s
)=
//Get header of the part
if find_the_first(body_temp_file, crlf+crlf, start_offset, end_offset) is
{
failure then failure,
success(k) then
if (Maybe(RStream))file(body_temp_file, read) is
{
failure then failure,
success(body_fd) then
if read_bytes(make_data_io(body_fd, start_offset, k), k) is success(header_part) then
if find_name_and_filename(header_part, 0, k) is
{
failure then failure,
success(n_mbfn) then if n_mbfn is (name, mbfn) then
if mbfn is
{
failure then
if read_bytes(make_data_io(body_fd, start_offset+k+4, (end_offset-2)-(start_offset+k+4)), (end_offset-2)-(start_offset+k+4)) is success(attachement) then
success(web_arg(name,to_string(attachement)))
// we must substract 2 to end because of crlf just before the boundary
else
failure,
success(fn) then
if save_uploaded_file(web_site_dir, body_fd, start_offset+k+4, end_offset-2, s) is
{
failure then failure,
success(tfn) then success(upload(name, remove_path(fn), web_site_dir+"/upload_temporary/"+tfn))
}
}
}
else
failure
}
}.
public define List(Web_arg)
read_multipart_form_data_encoded_web_args
(
String web_site_dir,
//Web_Site_Description desc,
String body_temp_file,
String __boundary,
Int file_offset,
SState s
) =
with boundary_length = length(__boundary),
println(
"read_multipart_form_data_encoded_web_args
boundary["+__boundary+"]
body_temp_file : "+body_temp_file+"
file_offset : "+file_offset);
//get the first boundary position
if find_the_first(body_temp_file, __boundary, file_offset) is
{
failure then println("first boundary NOT found");[ ],
success(_first) then
with first = _first + file_offset, //adjust the offset to real offset in file
//get the second boundary position
if find_the_first(body_temp_file, __boundary, first + boundary_length) is
{
failure then println("last boundary NOT found");[ ],
success(_last)then
with last = _last + first + boundary_length, //adjust the offset to real offset in file
//Extract the file content here
if get_multipart_entity(web_site_dir, body_temp_file, first+boundary_length, last, s) is
{
failure then [ ],
success(wa) then
[wa . read_multipart_form_data_encoded_web_args(web_site_dir, body_temp_file, __boundary, last, s)]
}
}
}.
define One
multipart_form_data_answer
(
String host_name,
Web_Site_Description desc,
Connection connection,
Word32 ip_addr,
HTTP_Request_Line request_line,
List(HTTP_header) headers,
String body_temp_file,
SState s
) =
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.site_directory,
body_temp_file,
"--"+boundary,
0,
s),
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, host_name, uri, headers, is_SSL(connection)),
// all_web_args,
// is_SSL(connection)),
// forget(reliable_write(connection, answer_headers_body)))
if (ext = ".awp" | ext = "") then
with http_inf = http_info(ip_addr, host_name, uri, headers, is_SSL(connection)),
if awp_handler(desc)(host_name, http_inf, all_web_args, is_SSL(connection)) is
{
printable_tree(answer_headers_body) then
forget(reliable_write(connection, answer_headers_body)),
send_file(file_path, c_disposition) then
send_file_answer(desc, connection, uri, file_path, c_disposition, headers, standard_headers,
(One u) |-> before_send_file(desc)(http_inf, all_web_args))
}
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,
Int 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
(
Redirections redirections,
String uri, // original URI
List(HTTP_header) headers
)=
if get_host_header_value(headers) is
{
failure then uri,
success(host) then
if redirections is
{
redirection_list(l) then handle_redirection(uri, host, l)
redirection_fn(f) then f(uri, host)
}
}.
*** [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) //content-type not found, check the next header line
}.
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,
SState s
)=
if rqline is request_line(type, uri, qstring) then
with rqline2 = 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, rqline2, headers, body, generate_tt),
multipart_form_data then multipart_form_data_answer(host_name, desc, connection, ip_addr, rqline2, headers, body, generate_tt, s)
}.
*** [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),
if sites is
{
[] then get_site(requested_host,sites),
[site . t] then 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,
HTTP_Buffered_Connection connection,
Bool is_https,
SState s,
(One) -> Bool shutdown_required
) =
//t0 <- (UTime)unow;
with start_time = (Int)now,
s.sttm <- start_time;
//println("Request time: " + format_http_date(start_time));
if shutdown_required(unique) then
println("shutdown required on http_https_handler");
unique
else
//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) is
{
error(msg) then print(format(msg)),
ok(rqline) then //request line
//print_delta("read_request_line");
if read_http_headers(connection) is
{
error(msg) then print(format(msg)),
ok(headers) then //print_delta("read_http_headers");
if get_site(headers,sites) is
{
failure then unique,
success(p) then if p is (host_name, desc) then
//Body Size
if get_body_size(headers) is
{
error(msg) then log_journal_msg(desc,format(msg)),
ok(body_size) then
if rqline is request_line(method, uri, qstring) then
with rqline2 = request_line(method, handle_redirection(redirections(desc), uri, headers), qstring),
//Get the type of encoding which decide if we read the content in ByteArray for www_url or in
//temporary file for multipart.
//with generate_tt = make_generate_trust_ticket(dos),
if get_encoding_type(headers) is
{
//WWW_URL
www_url 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
//HERE produce the answer of the server
www_url_answer(host_name, desc, connection.conn, ip_addr, rqline2, headers, body);
//it's HTTP 1.1 keep-alive is default
http_https_handler(sites, connection, is_https, s, shutdown_required)
}
//MULTIPART_FORM_DATA
multipart_form_data then
if body_size > 0 then
with t0 = (UTime)unow,
if get_socket_from_connection(conn(connection)) is
{
failure then println("can't get socket"),
success(socket_type) then
with tmp_body_file = "/temp/" + virtual_machine_id + "-" + now,
if (Maybe(RWStream))file(desc.site_directory + tmp_body_file, new) is
{
failure then println("can't create target file "+desc.site_directory + tmp_body_file),//nothing to write
success(target) then
//get the content of the current buffer and unput char list
with buffer = get_and_erase_buffer(connection),
buffer_size = length(buffer),
//println("buffer Size = "+buffer_size);
//println("Old body size "+body_size+" New body size request = "+body_size - buffer_size);
if flush(buffer, weaken(target)) is
{
failure then println("Can't flush the buffer"),
success(_) then
if socket_type is
{
tcp_socket(source) then
if copy_file(weaken(source), weaken(target), body_size - buffer_size) is copy_ok(read_size) then
with duration = (UTime) unow - t0,
println("Read body "+read_size+" duration: " + __utime_to_string(duration));
multipart_form_data_answer(host_name, desc, connection.conn, ip_addr, rqline2, headers, desc.site_directory + tmp_body_file, s);
//it's HTTP 1.1 keep-alive is default
http_https_handler(sites, connection, is_https, s, shutdown_required)
else
println("Can't copy data from stream to temporary file "),
ssl_socket(source) then
if copy_file(source, weaken(target), body_size - buffer_size) is copy_ok(read_size) then
with duration = (UTime) unow - t0,
println("Read body "+read_size+" duration: " + __utime_to_string(duration));
multipart_form_data_answer(host_name, desc, connection.conn, ip_addr, rqline2, headers, desc.site_directory + tmp_body_file, s);
//it's HTTP 1.1 keep-alive is default
http_https_handler(sites, connection, is_https, s, shutdown_required)
else
println("Can't copy data from stream to temporary file ")
}
}}}
else
println("body_size = 0 !")
}
//print_delta("before send_answer");
// with body = constant_byte_array(0,0),
// send_answer(host_name, desc,connection.conn, request_line, headers, body,
// make_generate_trust_ticket(dos), s);
// //it's HTTP 1.1 keep-alive is default
// http_https_handler(sites, connection, is_https, dos, s)
//with duration = (UTime) unow - *t0,
//println("Request duration: " + __utime_to_string(duration))
//println("BufferRead duration: " + __utime_to_string(*t1));
//println("next_char duration: " + __utime_to_string(*t2))
}
}
}
}.
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(Word32 ip, DenialOfService dos).
define Server -> ((RWStream) -> One)
make_http_handler
(
List(Web_Site_Description) sites,
(One) -> Bool shutdown_required
) =
(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 = http_buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0), var([])),
http_https_handler(sites, connection, false, sstate(var(0),var(0)), shutdown_required).
public define One
http_direct_handler
(
List(Web_Site_Description) sites,
RWStream conn,
(One) -> Bool shutdown_required
) =
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 = http_buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0), var([])),
http_https_handler(sites, connection, false, sstate(var(0),var(0)), shutdown_required).
define Server -> (SSL_Connection -> One)
make_https_handler
(
List(Web_Site_Description) sites,
(One) -> Bool shutdown_required
) =
(Server server) |-> (SSL_Connection conn) |->
with connection = http_buffered_connection(ssl(conn), var(constant_byte_array(0, 0)), var(0), var([])),
http_https_handler(sites, connection, true, sstate(var(0),var(0)), shutdown_required).
*** [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 to_Int(d)+600 < now then forget(remove(dir+name)) else unique,
link(name,_,_,d) then if to_Int(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,
Int period,
Int 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,
Int 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(Int) counter
) =
protect with n = *counter,
if n >= 100
then false
else (counter <- (*counter)+1); true.
define One
decrement_connections_counter
(
Var(Int) counter
) =
protect counter <- (*counter)-1.
*** [6.4.2] Recording dubious IP addresses.
define List(DubiousIP)
record_dubious_IP
(
Word32 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
(
Word32 dubious_IP,
Var(List(DubiousIP)) v
) =
protect v <- record_dubious_IP(dubious_IP,*v).
define One
record_dubious_IP
(
Word32 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
(
Word32 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
(
Word32 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,
Int 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 = (Int)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));
forget(make_directory(site_dir+"/states",default_directory_mode));
forget(make_directory(site_dir+"/temp",default_directory_mode));
create_directories(others)
}.
Below are the commands for starting an HTTP server and an HTTPS server.
define StartServerResult
start_http_server
(
Word32 ip_address,
Word32 port,
Server -> ((RWStream) -> One) handler,
Int 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).
public define StartServerResult
start_http_server
(
Word32 ip_address,
Word32 port,
List(Web_Site_Description) sites,
(One) -> Bool shutdown_required
) =
create_directories(sites);
start_http_server(ip_address,port,
make_http_handler(sites, shutdown_required),
0).
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
(
Word32 ip_address,
Word32 port,
String certificate_common_name,
Server -> (SSL_Connection -> One) handler,
Int retries
) =
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).
public define StartServerResult
start_https_server
(
Word32 ip_address,
Word32 port,
String certificate_common_name, // of SSL server certificate
List(Web_Site_Description) sites,
(One) -> Bool shutdown_required
) =
create_directories(sites);
start_https_server(ip_address,port,certificate_common_name,
make_https_handler(sites, shutdown_required),
0).
*** [7] The web dispatcher.
*** [7.1] The dispatcher server.
define One
send_dispatching_page
(
RWStream conn,
String common_name,
Word32 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,
SState ss
) =
(Server server) |-> (RWStream conn) |->
with start_time = (Int)now,
connection = http_buffered_connection(tcp(conn), var(constant_byte_array(0, 0)), var(0), var([])),
if read_request_line(connection) is
{
error(msg) then print(format(msg)),
ok(request_line) then
if read_http_headers(connection) 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(Int) 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 <- to_Int(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(Int) 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
(
Word32 ip_address, // address for listening (typically 0: listen on all interfaces)
Word32 http_port, // typically 80
DenialOfService dos,
SState s
) =
with info_file_path = my_anubis_directory+"/web_sites/dispatcher.info",
info_v = var((List(DispatcherInfo))[]),
info_date_v = var((Int)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, s),
(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 Word32
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 Word32
register_ip_port
=
if decimal_scan(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 truncate_to_Word32(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,
Int l
) =
if length(s) >= l
then s
else s+constant_string(l-length(s),' ').
define One
show_sites_1
(
List(DispatcherInfo) l,
Int 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,
Int i
) =
print(" Name Port\n");
print(" --------------------------------------------------------\n");
show_sites_1(l,i).
define List(DispatcherInfo)
replace_info
(
List(DispatcherInfo) l,
String site_name,
Word32 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,
Word32 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 decimal_scan(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,
Word32 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 decimal_scan(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)
}.
public define String
to_String
(
HTTP_Status status
)=
if status is
{
http_continue then "100 Continue",
http_switching_protocol then "101 Switching Protocols",
http_ok then "200 OK",
http_created then "201 Created",
http_accepted then "202 Accepted",
http_non_authoritative_info then "203 Non-Authoritative Information",
http_no_content then "204 No Content",
http_reset_content then "205 Reset Content",
http_partial_content then "206 Partial Content",
http_multiple_choices then "300 Multiple Choices",
http_moved_permanently(loc) then "301 Moved Permanently Location ="+loc,
http_moved_temporarily(loc) then "302 Moved Temporarily Location ="+loc,
http_see_other(loc) then "303 See Other Location ="+loc,
http_not_modified then "304 Not Modified",
http_use_proxy(loc) then "305 Use Proxy Location ="+loc,
http_temporary_redirect(loc) then "307 Temporary Redirect Location ="+loc,
http_bad_request then "400 Bad Request",
http_unauthorized then "401 Unauthorized",
http_payment_required then "402 Payment Required",
http_forbidden then "403 Forbidden",
http_not_found then "404 Not Found",
http_method_not_allowed then "405 Method Not Allowed",
http_not_acceptable then "406 Not Acceptable",
http_proxy_authentification_required then "407 Proxy Authentication Required",
http_request_timeout then "408 Request Time-out",
http_conflict then "409 Conflict",
http_gone then "410 Gone",
http_length_required then "411 Length Required",
http_precondition_failed then "412 Precondition Failed",
http_request_entity_too_large then "413 Request Entity Too Large",
http_request_uri_too_long then "414 Request-URI Too Long",
http_unsupported_media_type then "415 Unsupported Media Type",
http_request_range_unsatisfiable then "416 Requested range unsatisfiable",
http_expectation_failed then "417 Expectation failed",
http_internal_server_error then "500 Internal Server Error",
http_not_implemented then "501 Not Implemented",
http_bad_gateway then "502 Bad Gateway",
http_service_unavailable then "503 Service Unavailable",
http_gateway_timeout then "504 Gateway Time-out",
http_version_not_supported then "505 HTTP Version not supported"
http_error(code, message) then abs_to_decimal(code) + " " + message
}.
public define (String, List(HTTP_header))
format
(
HTTP_Status status
) =
if status is
{
http_continue then ("100 Continue", []),
http_switching_protocol then ("101 Switching Protocols", []),
http_ok then ("200 OK", []),
http_created then ("201 Created", []),
http_accepted then ("202 Accepted", []),
http_non_authoritative_info then ("203 Non-Authoritative Information", []),
http_no_content then ("204 No Content", []),
http_reset_content then ("205 Reset Content", []),
http_partial_content then ("206 Partial Content", []),
http_multiple_choices then ("300 Multiple Choices", []),
http_moved_permanently(loc) then ("301 Moved Permanently", [http_header("Location", loc)]),
http_moved_temporarily(loc) then ("302 Moved Temporarily", [http_header("Location", loc)]),
http_see_other(loc) then ("303 See Other", [http_header("Location", loc)]),
http_not_modified then ("304 Not Modified", []),
http_use_proxy(loc) then ("305 Use Proxy", [http_header("Location", loc)]),
http_temporary_redirect(loc) then ("307 Temporary Redirect", [http_header("Location", loc)]),
http_bad_request then ("400 Bad Request", []),
http_unauthorized then ("401 Unauthorized", []),
http_payment_required then ("402 Payment Required", []),
http_forbidden then ("403 Forbidden", []),
http_not_found then ("404 Not Found", []),
http_method_not_allowed then ("405 Method Not Allowed", []),
http_not_acceptable then ("406 Not Acceptable", []),
http_proxy_authentification_required then ("407 Proxy Authentication Required", []),
http_request_timeout then ("408 Request Time-out", []),
http_conflict then ("409 Conflict", []),
http_gone then ("410 Gone", []),
http_length_required then ("411 Length Required", []),
http_precondition_failed then ("412 Precondition Failed", []),
http_request_entity_too_large then ("413 Request Entity Too Large", []),
http_request_uri_too_long then ("414 Request-URI Too Long", []),
http_unsupported_media_type then ("415 Unsupported Media Type", []),
http_request_range_unsatisfiable then ("416 Requested range unsatisfiable", []),
http_expectation_failed then ("417 Expectation failed", []),
http_internal_server_error then ("500 Internal Server Error", []),
http_not_implemented then ("501 Not Implemented", []),
http_bad_gateway then ("502 Bad Gateway", []),
http_service_unavailable then ("503 Service Unavailable", []),
http_gateway_timeout then ("504 Gateway Time-out", []),
http_version_not_supported then ("505 HTTP Version not supported", []),
http_error(code, message) then (abs_to_decimal(code) + " " + message, [])
}.