Miscellany

(* routines for reading and writing while only blocking the
 * current thread of execution *)
let thread_read_line fd =
    let s = " " and r = ref "" in
    while (Unix.read fd s 0 1 > 0) && s.[0] <> '\n' do
        r := !r ^ s
    done; !r

let thread_write_string fd str =
    ignore (Unix.write fd str 0 (String.length str))

let thread_write_endline fd str =
    thread_write_string fd (str ^ "\n")

(*** actual networking code ***)

let gen_connection_num =
    let c = ref 0 in
    (fun () -> incr c; !c)

exception Done

(* just for something to do with our clients, unimportant *)
let counter = ref 0

class connection (sd, sa) = object (self)
    val socket = sd
    val addr = sa
    val mutable number = 0
    initializer
        number <- gen_connection_num ();

    method start () =
        Thread.create (fun x ->
            self#run x;
            self#stop x) ()

    method stop () =
        Unix.close socket

    method run () =
        try while true do
            (* do things here, terminate the thread with 'raise Done'.  as a
             * demonstration, we count for our clients, keeping track of a
             * server-global counter state *)
            let line = thread_read_line socket in
            counter := !counter + 1;
            thread_write_endline socket (string_of_int !counter)
        done with
            | Done -> () (* thread terminated normally *)
            | exn -> print_string (Printexc.to_string exn); print_newline ()
end

class serv_socket p = object (self)
    val port = p
    val mutable sock = Unix.socket Unix.PF_INET Unix.SOCK_STREAM 0
    val queue_limit = 3

    initializer
        Unix.bind sock (Unix.ADDR_INET(Unix.inet_addr_any, port));
        Unix.listen sock queue_limit

    method private client_addr = function
        Unix.ADDR_INET(host, _) -> Unix.string_of_inet_addr host
        | _ -> "Client connecting from non-internet host???"

    method run () =
        while true do
            let (sd, sa) = Unix.accept sock in
            let connection = new connection (sd, sa) in
            ignore (connection#start ())
        done
end

let _ =
    let port = 4226 in
    Unix.handle_unix_error (fun () ->
        let s = new serv_socket port in s#run ()) ()