On ajoute d'abord quelques fonctions d'usage général dans inet.ml.
      
(** Ouverture et attachement d'une socket server à un port local *)
let open_server port =
  try
    let socket = socket PF_INET SOCK_STREAM 0 in
    setsockopt socket SO_REUSEADDR true;
    bind socket (ADDR_INET (inet_addr_anyport));
    listen socket 20;
    socket
  with _ ->
    let message = sprintf "open_server %d: can't open" port in
    raise (Failure message);;
      
let string_of_sockaddr s = match s with
  | ADDR_UNIX s -> s
  | ADDR_INET (inet,p) -> (string_of_inet_addr inet)^":"^(string_of_int p);;

      
(** Serveur TCP itératif appliquant une fonction sur les données reçues
   avant de les renvoyer *)

let rec establish_iterative_server f port =
  let socket_server = open_server port in
  ignore (Sys.signal Sys.sigpipe Sys.Signal_ignore);
  let rec server () =
    let socket_connection,client_addr = accept socket_server in
    setsockopt_float socket_connection SO_RCVTIMEO 10.;
    setsockopt_float socket_connection SO_SNDTIMEO 10.;
    Printf.eprintf "Connection from %s.\n" (string_of_sockaddr client_addr);
    flush Pervasives.stderr;
    Pervasives.flush Pervasives.stderr;
    f socket_connection;
    server () in
  try server () with
    Unix_error(_,"accept",_) ->
      raise (Failure "establish_iterative_server: accept")
  | _ ->  raise (Failure "Unexpected Error")

      
let try_finalize f x finally y =
  let res = try f x with exn -> finally yraise exn in
  finally y;
  res;;

(** Gestion d'une connexion *)
let treat_connection f socket =
  let buffer_size = 4096 in
  let buffer = String.create buffer_size in
  let rec treat () =
    match read socket buffer 0 buffer_size with
    | 0 -> close socket
    | nb ->
        let v = f (String.sub buffer 0 nbin
        ignore (write socket v 0 nb);
        treat () in
  try
    try_finalize treat () close socket
  with _ ->
    fprintf Pervasives.stderr "treatment error\n";
    flush Pervasives.stderr;;

On écrit alors très simplement le serveur itératif:
      
open Unix;;
open Inet;;

(** Récupération des arguments *)
let main () =
  if Array.length Sys.argv <> 2 then
    begin
      prerr_endline ("Usage: "^Sys.argv.(0)^" port");
      exit 1
    end
  else
    try
      establish_iterative_server
        (treat_connection String.uppercase) (port_of_string Sys.argv.(1))
    with Failure message ->
      prerr_endline message;
      exit 2;;

main ();;
Pour le serveur concurrent, on écrit à nouveau la fonction d'usage général dans inet.ml.
      
open Sys;;

let establish_concurrent_server f port =
  (* Récupération de tous les zombis *)
  let rec wait_for_children signal =
    try
      let pid,_ = waitpid [WNOHANG] (-1) in
      if pid <> 0 then wait_for_children signal
    with Unix_error(ECHILD,_,_) -> () in
  ignore (signal sigchld (Signal_handle wait_for_children));
  ignore (signal sigpipe Signal_ignore);
  (* Service de chaque connexion *)
  let socket_server = open_server port in
  let rec server () =
    begin
      try
        let socket_connectionclient_addr = accept socket_server in
        setsockopt_float socket_connection SO_RCVTIMEO 10.;
        setsockopt_float socket_connection SO_SNDTIMEO 10.;
        eprintf "Connection from %s.\n" (string_of_sockaddr client_addr);
        Pervasives.flush Pervasives.stderr;
        try
          match fork () with
          | 0 -> f socket_connectionexit 0
          | pid -> close socket_connection
        with Unix_error ((EAGAIN | ENOMEMas err__) ->
          close socket_connection;
          prerr_endline (error_message err)
      with Unix_error(EINTR,_,_) -> ()
    end;
    server ()
  in server ();;
Et voici le serveur concurrent:
      
open Unix;;
open Inet;;

(** Récupération des arguments *)
let main () =
  if Array.length Sys.argv <> 2 then
    begin
      prerr_endline ("Usage: "^Sys.argv.(0)^" port");
      exit 1
    end
  else
    try
      establish_concurrent_server
        (treat_connection String.uppercase) (port_of_string Sys.argv.(1))
    with Failure message ->
      prerr_endline message;
      exit 2;;

main ();;