Mis à jour le 7 mars 2006
TD 6

TD 6

Mardi 28 février 2006

1  Questions de cours
On écrira ses réponses en ASCII dans un fichier, un par question que l'on déposera par le WEB.

Questions de cours

Question 1.1

À votre avis,
  1. les commandes fork et exec peuvent-elles échouer?

  2. Donner le cas échéant pour chacune d'entre elles les causes possibles d'erreur.

  3. La commande fork peut-elle être interrompue par un signal?


Question 1.2

Que fait le code suivant?
      
    let errput = stderr in dup2 errput stderr; close errput;
    write stderr "Message\n" 0 8;;


Question 1.3

Donner le code de la fonction command qui prend en argument un tableau de chaîne de caractères [| cmd; arg1; ... argn; |] et lance le programme cmd (on ne le cherchera pas dans le chemin d'exécution) avec les arguments arg1, ... argn. La commande attend la fin du programme et retourne le code de retour du programme, ou bien un entier négatif si le programme s'est mal terminé.

On ne changera pas le comportement du programme principal vis-à-vis des signaux pendant l'exécution de la commande. Les erreurs dans le programme principal seront considérées comme fatales.



2  Un client tcp

Écrire une commande mon_wget qui prend en argument un nom de machine <machine>, un numéro de port <port>, un chemin d'accès <path> et qui affiche, sur la sortie standard, le résultat de la requête HTTP vers l'url «http://<machine>:<port>/<path>». On rappelle que le format d'une requête HTTP/1.0 est «GET /<path> HTTP/1.0\r\n\r\n».

(corrigé)
On commence par écrire quelques fonctions utilitaires que l'on regroupe dans un fichier inet.ml.

On commencer par une fonction open_connection addr port qui prend en argument une adresse internet de type inet_addr et un numéro de port TCP sous la forme d'un entier et qui retourne le descripteur d'une prise connectée au serveur correspondant à cette adresse et à ce port. Si la connexion a échoué la fonction devra lever une exception Failure indiquant que la connexion vers cette adresse et ce port a échoué.
      
open Unix;;
open Printf;;

(** Ouverture et connexion d'une socket *)
let open_connection address port =
  try
    let socket = socket PF_INET SOCK_STREAM 0 in
    connect socket (ADDR_INET (address,port));
    socket
  with _ ->
    let addr = string_of_inet_addr address in
    let message =
      sprintf "open_connection %s %d : unable to connect" addr port in
    raise (Failure message);;
On écrit une fonction inet_addr_of_name qui retourne une adresse de type inet_addr à partir d'un nom de machine ou d'un numéro IP passé sous forme de chaîne de caractères. En cas d'erreur la fonction devra lever une exception Failure.
      
(** Conversion d'une chaîne de caratères en adresse Internet *)
let inet_addr_of_name machine =
  try
    (gethostbyname machine).h_addr_list.(0)
  with _ ->
    try
      inet_addr_of_string machine
    with _ ->
      let message =
        sprintf "inet_addr_of_name %s : unknown machine" machine in
      raise (Failure message);;
Enfin, on écrit une fonction port_of_string qui retourne un numéro de port à partir d'un nom de service ou d'un entier passés sous forme de chaîne de caractères. Cette fonction devra lever une exception Failure en cas d'erreur.
      
(** Conversion d'une chaîne de caratères en n° de port tcp *)
let port_of_string port =
  try
    try
      (getservbyname port "tcp").s_port
    with Not_found -> int_of_string port
  with _ -> raise (Failure ("port_of_string "^ port));;
On peut mainteant passe au programme mon_wget.ml.

      
open Sys;;
open Unix;;
open Printf;;
open Inet;;

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

(** Client HTTP/0.9 *)
let http_client machine port path =
  let p = port_of_string port in
  let addr = inet_addr_of_name machine in
  let socket = open_connection addr p in
  let command = sprintf "GET %s\r\n" path in
  try
    ignore (signal sigpipe Signal_ignore);
    ignore (write socket command 0 (String.length command));
    let buffer_size = 4096 in
    let buffer = String.create buffer_size in
    let rec display () =
      match read socket buffer 0 buffer_size with
        0 -> ()
      | nb -> output Pervasives.stdout buffer 0 nb; display () in
    try_finalize display () close socket
  with _ ->
    let message = sprintf "http_client %s %s %s I/O error" machine port path in
    raise (Failure message);;
Reste la fonction principale qui gère les arguments passés sur la ligne de commande.
      
let main () =
  if Array.length Sys.argv <> 4 then
    begin
      prerr_endline ("Usage: "^Sys.argv.(0)^" machine port path");
      exit 1
    end
  else
    try
      http_client Sys.argv.(1) Sys.argv.(2) Sys.argv.(3)
    with Failure message  ->
      prerr_endline  message;
      exit 2;;

main ();;

3  Un serveur tcp

On désire écrire un serveur de mise en majuscule qui accepte une connexion TCP sur un port particulier p, lit les caractères reçus sur cette connexion et les renvoie après les avoir mis en majuscule, jusqu'à ce que la connexion soit fermée, puis se remet en attente de connexion.

Écrire une version itérative (qui n'accepte qu'un client à la fois) de votre serveur.

Écrire une version concurrente de votre serveur qui crée un processus pour traiter chaque requête reçue.

Pour tester vos serveurs vous pouvez utiliser telnet localhost p.

Pour permettre une réutilisation rapide du port TCP du serveur on utilisera setsockopt avec l'option SO_REUSEADDR.

Pour éviter les attentes trop longues, on utilisera setsockopt_float avec les options SO_SNDTIMEO et SO_RCVTIMEO avec une valeur de 10 secondes. Toutefois, il faut savoir que ces options peuvent, sur certaines implémentations, ne pas être modifiables (mais seulement consultables). On devra donc ignorer une erreur éventuelle lors de l'affectation de ces options.
(corrigé)
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_any, port));
    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 y; raise 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 nb) in
        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_connection, client_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_connection; exit 0
          | pid -> close socket_connection
        with Unix_error ((EAGAIN | ENOMEM) as 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 ();;


4  Un cat en tcp

Écrire une commande mon_netcat qui prend en argument un nom de machine m, un numéro de port p et qui se connecte sur le port p de la machine m, puis recopie tout ce qui est lu sur l'entrée standard sur la connexion et tout ce qui est lu sur la connexion sur sa sortie standard. La commande termine lorsque la connexion est fermée. Pour cet exercice, on utilisera un seul processus et la fonction Unix.select.

(corrigé)
      
open Sys;;
open Unix;;
open Inet;;

(** Fonction de recopie *)
let netcat machine port =
  let socket = open_connection machine port in
  ignore (signal sigpipe Signal_ignore);
  let buffer_size = 1024 in
  let buffer = String.create buffer_size in
  let descriptors = ref [socket;stdin] in
  let rec multiplex () =
    let read,_,_ = select !descriptors [] [] (-1.) in
    List.iter copy read;
  and copy fd =
    begin
      if fd = socket then
        begin
          match read socket buffer 0 buffer_size with
            0 -> close socket
          | nb -> ignore (write stdout buffer 0 nb); multiplex ()
        end
      else
        begin
          match read stdin buffer 0 buffer_size with
            0 ->  descriptors := [socket]; multiplex ()
          | nb -> ignore (write socket buffer 0 nb); multiplex()
        end
    end in
  try  multiplex ()  with _ -> raise (Failure "netcat IO error");;

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

main ();;

5  Un multiplexeur de serveurs tcp

Écrire une fonction inetd qui prend en argument une liste de couples de la forme (<port>, <cmd_argv>) et qui attend les connexions TCP sur n'importe lequel des ports de la liste. À chaque connexion provenant de l'extérieur sur l'un de ces ports, la fonction accepte la connexion puis exécute, dans un nouveau processus, la commande qui lui est associée en redirigeant l'entrée standard, la sortie standard et la sortie d'erreur vers la connexion.

(corrigé)
      
open Unix;;
open Sys;;
open Inet;;

(** Installation d'un service. *)
let install_service (port, service) =
  Printf.eprintf "Service \"%s\" on port %d\n" service.(0) port;
  Pervasives.flush Pervasives.stderr;
  let socket = open_server port in
  (socket, service);;

(** Exécution d'un service. *)
let exec_service command socket =
  try
    match fork () with
      0 ->
        let exec () =
          dup2 socket stdin;
          dup2 socket stdout;
          dup2 socket stderr;
          close socket;
          execvp command.(0) command;
          in
        handle_unix_error exec ();
        assert false
    | _ ->
        close socket
  with Unix_error ((EAGAIN|ENOMEM),"fork",_) ->
    close socket;
    prerr_endline "No more process available";;

(** Attente de tous les fils décédés. *)
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,_,_) -> ();;

(** Démarrage du démon *)
let inetd services =
  (* Gestion du signal SICHLD pour récupérer les zombis *)
  ignore (signal sigchld (Signal_handle wait_for_children));
  (* On ignore SIGPIPE et on recevra une erreur EPIPE lorsqu'on parle à
     un client qui à couper brutalement la connection. *)
  ignore (signal sigpipe Signal_ignore);
  (* installer les services *)
  let installed_services = List.map install_service services in
  (* construire la liste des sockets à écouter *)
  let sockets = List.map fst installed_services in
  (* acceptation d'une connexion et démarrage de la command associée *)
  let rec accept_connection server_socket =
    try
      let connection_socket,remote_addr = accept server_socket in
      Printf.eprintf "Connexion depuis %s\n" (string_of_sockaddr remote_addr);
      Pervasives.flush Pervasives.stderr;
      try
        (* chercher le service associé à la socket *)
        let command = List.assoc server_socket installed_services in
        (* exécuter le service avec la connexion fd *)
        exec_service command connection_socket
      with Not_found -> close connection_socket
    with Unix_error(EINTR,_,_) -> accept_connection server_socket in
  (* traitement du serveur *)
  let rec treatment () =
    begin
      try
        (* attente d'une connexion sur l'une des sockets *)
        let connections,_,_ = select sockets [] [] (-1.) in
        (* acceptation de toutes les connexions en attente sur socket_serveur *)
        List.iter accept_connection connections
      with Unix_error (EINTR,_,_) -> ()
    end;
    treatment () in
  treatment();;

(** Définition des services : liste de (port, command). *)
let services = [ (7000, [| "cat" |]); (7001, [| "date"; "-I" |]); (7002, [| "ocaml" |]) ];;

handle_unix_error inetd services;;


Ce document a été traduit de LATEX par HEVEA