The Server Layer

This layer contains code for managing the sockets and running the HTTP protocol over a client connection.

The Listener Module

As explained in the section called The Architecture of the Server in Chapter 8 each socket is handled by a separate thread. The listener thread waits for a new connection and then spawns a thread for the new connection.

The listener thread counts the connection threads and refuses new connections when the configured limit is reached. There are two ways to implement this. In both cases the central issue is how the listener thread discovers when a connection has terminated. The straightforward approach is to wait on a join event for each connection thread together with an accept event for a new connection. The code would be something like this.

fun server threads =
let
    fun join thread = 
    let
        fun keep t = not(CML.sameTid(t, thread))
        fun remove() = List.filter keep threads
    in
        CML.wrap(CML.joinEvt thread, remove)
    end

    val ac_evt = CML.wrap(Socket.acceptEvt listener, new_connection threads)
    val join_evts = map join threads

    val new_threads = CML.select (ac_evt::join_evts)
in
    server new_threads
end

This is a server loop for a listener. The state is the list of connection threads. Here the join function associates each connection thread with a remove function that removes the thread from the list. At the same time it waits for an accept event on the listening socket. (The acceptEvt function is a CML extension of the Socket module).

My concern with this implementation is the overhead if the number of connections is large. If I dream of my server one day running a site with hundreds of connections then I'm not keen on all this processing over long lists of threads. All I really need to do is count the connection threads. So I have a connection thread send a message to the listener thread when it terminates. Here is the body of the listener thread which runs as the main thread of the server.

and serve listener max_clients conn_timeout =
let
    val lchan: ListenMsg CML.chan = CML.channel()

    fun loop num_connects =
    let
        (*  If we have too many then we will refuse the new
            connection.  We require each connection thread to tell
            us when it dies.

            We won't log the connection refusals to avoid the log
            overflowing on a DOS attack.
        *)
        fun new_connect (conn, conn_addr) =
        (
            if (isSome max_clients) andalso
                    num_connects >= (valOf max_clients)
            then
            (
                Socket.close conn;
                num_connects
            )
            else
            (
                FileIO.setCloseExec(Socket.pollDesc conn);

                CML.spawn(MyProfile.timeIt "Listener connection"
                    (connection lchan conn conn_addr conn_timeout));

                num_connects+1
            )
        )
        handle x =>
            (
                (Socket.close conn) handle _ => ();
                Log.logExn x;
                num_connects
            )

        fun msg ConnDied = num_connects - 1

        val new_num = CML.select[
            CML.wrap(S.acceptEvt listener, new_connect),
            CML.wrap(CML.recvEvt lchan, msg)
            ]
    in
        loop new_num
    end
in
    loop 0
end
handle x =>
    (
        Socket.close listener;
        Log.logExn x;
        raise FatalX
    )

The arguments max_clients and conn_timeout are configuration parameters and listener is the socket to listen on. The configuration parameters are integer option values from the Config.ServerConfig type. (See the run function below).

The loop function implements a state machine with the number of connections as the state. The action happens at the call to CML.select. This waits for either a new connection on the listener socket or a message over the manager channel. The result from the event dispatch is a new state value, the new number of connections.

When a new connection arrives it is accepted and the socket and client's IP address are passed to the new_connect function. If a maximum number of clients is configured and the limit is exceeded then the connection is immediately closed. There is no change to the number of connections in this case. I could send back a HTTP status saying "503 Service Unavailable" but it is legal to just close the connection. If I have a connection limit then I'm worried about the load on the server and I won't want to waste more time telling the client to go away nicely.

If the connection is accepted then I spawn a thread to run the connection. The socket is marked as close-on-exec so that CGI child processes don't inherit it.

If there is an exception at this stage then I log it and close the channel. I'm careful here to not let another exception break the server loop.

If a ConnDied message comes in from a connection thread then this just decrements the number of connections.

Here is the run function which is called from main. It creates the listener socket and calls the above serve function.

fun run() =
let
    val ServerConfig {
            conn_timeout: int option,
            max_clients:  int option,
            listen_host,
            listen_port,
            ...
            } = getServerConfig()

    (*  Build an address for listening.
    *)
    val listen_addr =
        case listen_host of
          NONE => INetSock.any listen_port

        | SOME host =>
        (
            (*  The configuration is supposed to have validated
                the host.
            *)
            case NetHostDB.getByName host of
              NONE       => raise InternalError "invalid host"
            | SOME entry =>
                INetSock.toAddr(NetHostDB.addr entry, listen_port)
        )

    val listener = INetSock.TCP.socket()
in
    (*  Doing these fixes the type of the socket as passive. *)
    Socket.Ctl.setREUSEADDR(listener, true);
    Socket.bind(listener, listen_addr);
    Socket.listen(listener, 9);
    FileIO.setCloseExec(Socket.pollDesc listener);

    serve listener max_clients conn_timeout
end
handle x => (Log.logExn x; raise FatalX)

The server's configuration provides a port to listen on and optionally an IP address to bind the port to. This could be "localhost" for private use but it could be the address of a particular interface on a server. The getByName function is the equivalent of the C gethostbyname() function. The INetSock.toAddr function constructs the address for an internet socket. This address value is equivalent to the C sockaddr_in struct. The remainder of the steps are conventional for setting up a listener socket.

It's worth looking again at how the type of the listener socket is fixed by these function calls (see the section called The Specific Socket Types in Chapter 4). The INetSock.TCP.socket function involves these types in the INetSock structure. (I've added parentheses in stream_sock to show the precedence).

...
type 'a sock = (inet, 'a) Socket.sock
type 'a stream_sock = ('a Socket.stream) sock
...
structure TCP : sig
    val socket  : unit -> 'a stream_sock
    ...
end

Substituting these type equations gives the intermediate type for the socket as

(INetSock.inet, 'a Socket.stream) Socket.sock

In this type 'a is a place holder for the passive/active mode. The type of the listen function will constrain this variable to be Socket.passive giving the final type for a listening socket.

(INetSock.inet, Socket.passive Socket.stream) Socket.sock

This is the only type that the Socket.accept function will accept. So the type system ensures that you don't forget to call the listen function and similarly you can't accidentally accept on a connected socket.

Finally here is the code that controls the connection.

and connection lchan sock sock_addr conn_timeout () =
let
    fun run() =
    let
        val conn = MyProfile.timeIt "Listener setupConn"
                    Connect.setupConn{
                        socket  = sock,
                        sock_addr = sock_addr,
                        timeout = conn_timeout
                        }
    in
        MyProfile.timeIt "Listener talk" 
            HTTP_1_0.talk conn;

        MyProfile.timeIt "Listener close" 
            Connect.close conn;

        Log.testInform G.TestConnect Log.Debug
            (fn()=>TF.S "Connection closed");

        MyProfile.timeIt "Listener release" 
            TmpFile.releasePort(Connect.getPort conn);

        Log.testInform G.TestConnect Log.Debug
            (fn()=>TF.S "TmpFiles released")
    end

in
    Log.inform Log.Info (fn()=>TF.C [TF.S "New connection from ",
                                format_addr sock_addr]);

    MyProfile.timeIt "Listener run" 
        run();

    Log.inform Log.Info (fn()=>TF.C [TF.S "End of connection from ",
                                format_addr sock_addr]);

    MyProfile.timeIt "Listener died" 
        CML.send(lchan, ConnDied)
end
handle x =>
    let
        (*  See also Connect.getPort *)
        val (_, port) = INetSock.fromAddr sock_addr
    in
        (
            Socket.close sock;
            TmpFile.releasePort port
        ) handle _ => ();           (* being paranoid *)
        Log.logExn x;
        CML.send(lchan, ConnDied)
    end

Most of the bulk of the code is for handling contingencies. (The timeIt calls are there for performance testing). Essentially it runs the talk function in the HTTP protocol module and then closes the connection. The Connect.setupConn function wraps up the socket details into a connection value. It also starts a time-out for the connection if the server is configured for this. This time-out applies to the entire interval from the acceptance of the connection through to the closing including the running of any CGI scripts. An overview of the time-out handling can be found in the section called Time-outs in Chapter 8.

The TmpFile.releasePort function deletes any temporary files that have been created for the connection. They would typically contain posted HTTP entities for CGI scripts to read. The cleanup must be carefully repeated if any exception is caught. No exceptions can be allowed to get around the connection thread sending the ConnDied message or else the listener thread would slowly leak connection capacity.

The Connect Module

This module contains functions for I/O over a connection socket while looking out for a time-out condition.

The header of a HTTP request is line-oriented but there is no defined line-length limit. Even if there was, a robust server must be able to cope with arbitrarily long lines without a "buffer overflow" or filling memory. So I've decided on a line-length limit of 10000 which should be enough for header lines. Characters beyond the limit are discarded.

Since lines are usually terminated with a CR-LF sequence, custom line-reading code is required. This requires a buffer to accumulate chunks of characters from the socket until a complete line is received. See the readLine function for the code for the line splitting. In the rest of this section I'll only describe the lower-level details.

Here is the type for a connection.

datatype Conn = Conn of {
        socket:     Socket.active INetSock.stream_sock,
        port:       int,
        addr:       NetHostDB.in_addr,

        is_open:    bool ref,
        rdbuf:      string ref,
        rdlen:      int ref,        (* number of chars left *)
        rdoff:      int ref,        (* offset to next avail char *)

        (*  This transmits abort messages to all receivers. *)
        abort:      Abort.Abort
        }

The rdbuf field is a string buffer that is updated in place. The rdlen and rdoff fields point to a range of characters in the buffer that have not be processed yet. The abort field propagates a time-out condition to any party interested in the connection. Here is the function to create a connection value.

fun setupConn {socket, sock_addr, timeout} =
let
    (*  Apache has special linger handling but SO_LINGER works
        on Linux.
    *)
    val _ = S.Ctl.setLINGER(socket, SOME(Time.fromSeconds 2))

    val (addr, port) = INetSock.fromAddr sock_addr

    val abort =
        case timeout of
          NONE   => Abort.never()
        | SOME t => Abort.create t
in
    Conn {
        socket  = socket,
        port    = port,
        addr    = addr,
        is_open = ref true,
        rdbuf   = ref "",
        rdlen   = ref 0,
        rdoff   = ref 0,
        abort   = abort
        }
end

The LINGER option makes a close of the socket wait until the socket has finished sending all of the response back to the client (or until the 2 second time-out I've specified is reached). The alternative is that the close returns immediately and the socket drains in the background. But in this case during this draining it would not be counted against the server's connection limit. You could imagine a busy server accumulating an unlimited number of lingering sockets if they weren't counted.

The Abort.create function creates an abort object for the given time-out value. If no time-out is required then Abort.never creates a similar object that never times-out but can still be forced into the time-out state. If the connection is broken a time-out is forced so the server only has to test for the one condition.

The I/O functions raise the Timeout exception if they detect an attempt to read or write after a time-out. Here is the fill_buf function which is the core of the reading code. The various reading functions call fill_buf to get the next chunk of characters from the socket.

and fill_buf (Conn {socket, rdbuf, rdlen, rdoff, abort, ...}) =
let
    fun takeVec v =
    let
        val s = Byte.bytesToString v
    in
        rdbuf := s;
        rdlen := size s;
        rdoff := 0
    end
in
    CML.select [
        CML.wrap(Abort.evt abort, (fn() => raise Timeout)),
        CML.wrap(S.recvVecEvt(socket, 1024), takeVec)
        ]
end

It waits for a chunk of up to 1024 characters from the socket or until a time-out. The chunk is a vector of bytes which I convert to a string and place into the buffer. The Byte.bytesToString and Byte.stringToBytes functions are actually internally just type casts between a vector of bytes and a vector of characters. They don't have any run-time cost.

The opposite is the write function to send a string to a socket.

and write (conn as Conn {socket, is_open, ...}) msg =
(
    if !is_open 
    then
    let
        val bytes = Byte.stringToBytes msg
        val len   = size msg

        (*  n is the number of bytes written so far. *)
        fun loop n =
        (
            if aborted conn
            then
                raise Timeout
            else
            let
                (* val _ = toErr(concat["Connect.write sendVec n=", 
                            Int.toString n, " len=",
                            Int.toString len, "\n"]) *)
                val buf = {buf=bytes, i=n, sz=NONE}
                val sent = n + (S.sendVec(socket, buf))
            in
                if sent >= len
                then
                    ()
                else
                    loop sent
            end
        )
    in
        loop 0
    end
    else
        ()
)

Remember from the section called Time-outs in Chapter 8 that after a time-out some of the request processing may linger until the garbage collector cleans it up. The time-out will quickly force the socket to be closed via the Timeout exception being propagated into the HTTP_1_0 module. But the connection object may linger for some time and there may be further attempts to write to the connection. So all I/O functions check that the socket is still open and there hasn't been an abort condition before proceeding.

When sending to the socket there is the risk of a partial write. I need a loop to keep sending until all of the string is sent. The sendVec function makes it easy to send a message in chunks using the buf record type. A time-out is checked before each attempt.

The HTTP_1_0 Module

This module runs the HTTP version 1.0 protocol. This consists of reading in and parsing a request from the connection socket and writing back the response. It exports the one function talk.

fun talk conn =
let
    val req = MyProfile.timeIt "HTTP_1_0 get" get_request conn
in
    if G.testing G.TestShowRequest
    then
        (Req.dumpRequest req)
    else
        ();

    MyProfile.timeIt "HTTP_1_0 to_store" (fn()=>to_store conn req) ()
end
handle Bad status => send_status conn status

This just gets the request and sends it to the resource store. The store is expected to send a response back at some later time. If there is an error while reading the request the Bad exception will be raised and it will contain a status that can be sent back to the client. Usually this is just the "400 Bad Request" or "500 Server Fail" status.

Here is the get_request function. It reads the parts of a request in a straight-forward manner and builds the Request value.

and get_request conn : Req.Request =
let
    val (method, url, protocol) = get_request_line conn
    val headers = get_all_headers conn
    val entity  = get_entity headers conn
in
    Log.testInform G.TestShowRequest Log.Debug
        (fn()=>TF.S "got a request");

    Req.Request {
        method  = method,
        url     = url,
        protocol= protocol,
        headers = headers,
        entity  = entity,

        port    = Connect.getPort conn,
        client  = Connect.getAddress conn,

        rvar    = Sy.iVar(),
        abort   = Connect.getAbort conn
        }
end

I won't show the get_request_line function as it is just a simple bit of string splitting. The get_all_headers function is just a wrapper for the readAllHeaders function of the HTTP_Header module (see the section called The HTTPHeader Module). The get_entity function is more interesting.

and get_entity headers conn : Entity.Entity =
let
    val Config.ServerConfig {max_req_size, ...} = Config.getServerConfig()
    val chunk_size = 8192

    fun read_file len =
    let
        val _ = Log.testInform G.TestShowRequest Log.Debug
            (fn()=>TF.L ["HTTP reading into file len=",
                         Int.toString len])

        val (tmp_file, writer) = create_body_file conn len
        val strm = BinIOWriter.get writer

        fun loop 0 = ()
        |   loop n =
        (
            case Connect.read conn chunk_size of
              NONE        => Log.log Log.Warn (TF.S "short body")
            | SOME (s, _) =>
            (
                BinIO.output(strm, Byte.stringToBytes s);
                loop (n-(size s))
            )
        )
    in
        loop len;
        BinIOWriter.closeIt writer;
        Entity.tmpProducer tmp_file
    end
    handle x => (Log.logExn x; raise Bad Status.ServerFail)


    fun read_mem len =
    let
        val _ = Log.testInform G.TestShowRequest Log.Debug
            (fn()=>TF.L ["HTTP reading into mem len=",
                         Int.toString len])

        val (frag, _) = Connect.readAll conn len
    in
        Entity.textProducer frag
    end
    handle x => (Log.logExn x; raise Bad Status.ServerFail)


    (*  ReqTooLarge is v1.1 only but it's too good to avoid. *)
    fun check_req_limit len =
    (
        case max_req_size of
          NONE   => ()
        | SOME m => if len > m then
                        raise Bad Status.ReqTooLarge else ()
    )

    val einfo = Hdr.toEntityInfo headers
    val Entity.Info {length, ...} = einfo
in
    case length of
      NONE   => Entity.None

    | SOME n => 
        let
            val () = check_req_limit n

            val body =
                if n > body_limit
                then
                    read_file n
                else
                    read_mem n
        in
            Entity.Entity {
                info    = einfo,
                body    = body
                }
        end
end

All of the entity body is read in. First the headers are studied to get those relevant to the entity, in particular its length. If the length is 10000 (body_limit) bytes or less then I copy it into a string in memory. Everything from the socket is read in and passed to the textProducer function. This creates an entity with a producer function (see the section called Entities, Producers and Consumers in Chapter 8) which can deliver the content of the string.

If the file is larger than 10000 bytes then I copy it to a temporary file. Temporary files go into the directory specified by the TmpDir configuration parameter (see the section called The Server Parameters in Chapter 8). The file name includes the port number so that it is easy to clean up all temporary files associated with a connection. The create_body_file function (below) will create and open the temporary file. A loop transfers the entity to the file in chunks. It reads only exactly the number of bytes expected from the Length header. An entity is created with a producer that can deliver from a temporary file.

Here is the create_body_file function. It will block until there is enough disk space and file descriptors for the write to proceed. See the section called The Open File Manager for more details on this. The blocking may be aborted by a time-out condition.

and create_body_file conn len :(TmpFile.TmpFile * BinIOWriter.Holder)=
let
    val Config.ServerConfig {tmp_dir, ...} = Config.getServerConfig()
    val port  = Connect.getPort conn
    val abort = Connect.getAbort conn
in
    case TmpFile.newBodyFile abort tmp_dir len port of
      (* errors have already been logged *)
      NONE => raise Bad Status.ServerFail

    | SOME tmp =>
        (tmp, valOf(BinIOWriter.openIt abort (TmpFile.getName tmp)))
            handle x => raise Bad Status.ServerFail
end

Once the request is read it is send off to the resource store.

and to_store conn req =
let
    val Req.Request {rvar, abort, ...} = req
in
    Log.testInform G.TestStoreProto Log.Debug
        (fn()=>TF.S "HTTP: sending to the store");

    Store.deliver req;

    (*  Get a response or do nothing if there is an abort condition.
    *)
    CML.select[
        CML.wrap(Abort.evt abort, fn () => ()),

        CML.wrap(Sy.iGetEvt rvar,
                MyProfile.timeIt "HTTP_1_0 response"
                    (handle_response conn req))
        ]
end

The to_store function delivers it to the store and then blocks waiting for a response. The store processes multiple requests concurrently so it must send the response over the reply channel when it is ready. If a response is received it goes to handle_response. If there is a time-out before the response comes back then nothing is done and to_store returns immediately to the talk function which returns to the connection handler with nothing written to the socket. (Note that I haven't implemented Redirect requests from CGI scripts yet.)

A normal response is handled by this function.

and handle_response conn req response : unit =
let
    val Req.Request {method, abort, ...} = req
    val Req.Response {status, headers, entity} = response
in
    Log.testInform G.TestShowResponse Log.Debug
        (fn()=>TF.S "HTTP Protocol got a response");

    (
        send_status  conn status;
        send_headers conn headers;

        MyProfile.timeIt "HTTP_1_0 stream_entity"
            (fn() => stream_entity abort conn entity 
                    (method = Req.HEAD)
                    (Status.needsBody status)) 
            ()
    )
    handle
      Connect.Timeout => (Abort.force abort)
    | x => (Log.logExn x; Abort.force abort)
end

It just delivers the parts of the response to the connection: the status, headers and entity. Since there is writing to the connection there may be a Timeout exception (see the section called The Connect Module). I force the abort condition on any exception to make sure that it is broadcast to all interested parties.

Sending the status and headers of the response is straight-forward. Sending the entity is more interesting. As explained in the section called The Connection Protocol in Chapter 8 the entity is streamed out using a pair of producer and consumer. Here is the stream_entity function.

and stream_entity abort conn entity head_method needs_body =
let
    val csmr: Entity.Consumer = CML.channel()

    fun receiver() =
    (
        case CML.recv csmr of
          Entity.XferInfo info   => (send_info info; receiver())
        | Entity.XferBytes bytes => (send_bytes bytes; receiver())
        | Entity.XferDone        => ()
        | Entity.XferAbort       => ()
    )


    (*  Send the entity headers. *)
    and send_info info =
    let
        val hdrs = from_entity_info info
    in
        send_headers conn hdrs;
        end_headers conn
    end


    and send_bytes bytes =
    (
        if head_method
        then
            ()
        else
            Connect.write conn (Byte.bytesToString  bytes)
    )
in
    case entity of
      Entity.None => 
        (
            if needs_body                   (* see RFC1945 7.2 *)
            then
                Connect.write conn "Content-Length: 0\r\n"
            else
                ();
            end_headers conn
        )

    | _ =>
    let
        val pthread = Entity.startProducer abort entity csmr
        (* val _  = TraceCML.watch("producer", pthread) *)
    in
        (*  Don't skip the join. The producer must be allowed to
            clean up a CGI process nicely.
        *)
        receiver() handle x => Log.logExn x;
        CML.sync(CML.joinEvt pthread)  (* wait for producer to stop *)
    end
end

The receiver function behaves as a consumer receiving the entity transfer protocol over the csmr channel. Down the bottom of the function is the call to Entity.startProducer, for non-empty entities. This spawns a new thread to run the producer function. The receiver runs in the thread of the HTTP protocol code which is the same thread as manages the connection.

The head_method flag indicates that the request used the HEAD method therefore the body of the entity must be suppressed. It is necessary to run the transfer protocol to the end so that the producer, which may be a CGI script, can terminate properly. The needs_body flag indicates that the status code that is being returned requires an entity body. This is true for all informational statuses (in the 1xx range) and also "204 No Content" and "304 Not Modified". So if the entity happens not to have a body I have to insert an empty one.