Mis à jour le 7 mars 2006
TD 7

TD 7

Mardi 7 mars 2006


1  Questions de cours



Questions de cours

On fera cet exercice sans utiliser les notes de cours (ni les corrections de TD). On pourra utiliser la documentation OCaml (manuel, librairies, etc.) et Unix (pages man).
On veut écrire un serveur de façon modulaire. On distingue trois étapes:
  1. Branchement du port sur lequel on va établir le service.

  2. Traitement des connections clients

  3. Gestion des connections.
On va réaliser ces fonctions dans l'ordre inverse. On supposera que le serveur peut être interrompu pas un signal (par exemple sigstop pour arrêter et relancer le serveur).

Question 1.1

Écrire une fonction:
      
open Unix;;
val run_iterative_server : (file_descr -> unit) -> file_descr -> unit
qui prend en argument une fonction treat_connection qui gère une connection et une socket sur laquelle écouter les connections et gère le service de façon itérative.

Question 1.2

Écrire une fonction:
      
val treat_connection : file_descr -> unit
qui de façon aléatoire se comporte comme cat en renvoyant tout ce qui lui est envoyé, mais chiffre le message au passage. Pour simplifier, on chiffrera le message en associant à chaque caractère de code ASCII c, le code ASCII 256 − c. (On pourra commencer par écrire une fonction really_write de même interface que single_write mais qui s'assure que la quantité demandée est effectivement écrite.)

Question 1.3

Écrire une fonction
      
val open_server : inet_addr -> int -> file_descr
qui reçoit une adresse internet (de la machine sur laquelle s'exécute le programme), un entier représentant un port, ouvre un service à cette adresse sur ce port, et retourne la socket sur laquelle il peut accepter les connections.

Question 1.4

Conclure en écrivant une fonction
      
val establish_iterative_server : inet_addr -> int -> unit
qui établit le service de chiffrage à l'adresse internet et au port indiqué.

Question 1.5

En fait, on voudrait établir le même service sur deux adresses internet de la même machine, mais pas à toutes les adresses de la machine.

Écrire une fonction:
      
val run_iterative_server : (file_descr -> unit) -> file_descr list -> unit
qui se comporte comme run_iterative_server mais attend des connections sur l'une quelconque des prises reçues en second argument.



2  Agenda

On désire créer un petit agenda partagé (sur un mois), avec accès concurrent. Pour cela, nous proposons d'écrire un serveur utilisant des co-processus et un client qui effectue les opérations sur l'agenda par l'intermédiaire d'appels de fonctions distantes en OCaml.

Écrire un serveur avec un nombre fixe de co-processus qui protège l'accès à accept par un mutex. Pour assurer la cohérence de l'agenda, on impose qu'à tout instant, il y ait un unique écrivain ou (exclusif) plusieurs lecteurs en train de manipuler l'agenda. (On pourra utiliser la fonction Thread.delay pour amplifier le temps pris par l'écriture ou la lecture, afin de pouvoir observer les attentes sur le mutex.)

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

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

let establish_fixed_thread_number_server n f port =
  let socket_server = open_server port in
  let mutex = Mutex.create() in
  ignore (signal sigpipe Signal_ignore);
  let rec exclusive_accept () =
    begin
      try
        Mutex.lock mutex;
        let socket_connectionclient_addr =
          try_finalize accept socket_server Mutex.unlock mutex in
        Printf.eprintf "Connection from %s.\n"
          (string_of_sockaddr client_addr);
        Pervasives.flush Pervasives.stderr;
        f socket_connection
      with
        Unix_error(EINTR,_,_) -> ()
      | _ ->
          prerr_endline "Unrecoverable error";
          exit(1)
    end;
    exclusive_accept ()
  in
  for i = 1 to n-1 do ignore (Thread.create exclusive_accept ()) done;
  exclusive_accept ();;

      
type control =
    { mutex : Mutex.t;
      write_enable : Condition.t ;
      mutable readers : int };;
let create () =
  { mutex = Mutex.create ();
    write_enable = Condition.create();
    readers = 0;
 };;
      
let write_protect ctl f x =
  Mutex.lock ctl.mutex;
  while ctl.readers > 0 do Condition.wait ctl.write_enable ctl.mutex done;
  try_finalize f x Mutex.unlock ctl.mutex;;

let read_protect ctl f x =
  Mutex.lock ctl.mutex;
  ctl.readers <- ctl.readers + 1;
  Mutex.unlock ctl.mutex;
  let release() =
    Mutex.lock ctl.mutex;
    ctl.readers <- ctl.readers - 1;
    if ctl.readers = 0 then Condition.broadcast ctl.write_enable;
    Mutex.unlock ctl.mutex in
  try_finalize f x release ();;


Les types des opérations que le client pourra demander au serveur d'effectuer sont les suivantes:
      
type event = {start : intfinish : intinfo : string }
type day = (string*eventlist;;
type agenda = day array;;

type operation =
  | Get_agenda  (** demander les informations de tout l'agenda *)
  | Get_day of int (** demander les informations sur une journée *)
  | Add_event of string * int * int * int * string
        (** (nom, jour, heure début, heure fin, info) ajouter une entrée, le
           nom droit être unique le jour donné  *)

  | Delete_event of string * int;;
        (** (jour, nom) supprimer les informations de la journée donnée
           avec le nom donné *)


type result =
  | Unit
  | Agenda of agenda
  | Day of day
  | Exception of exn;;

Pour faire transiter entre le client et le serveur l'opération demandée sur l'agenda et son résultat (exception), on utilisera les fonctions input_value et output_value sur des in_channel et un out_channel construit autour du descripteur de prise.

(corrigé)
      
let agenda = ref (Array.make 31 []);;

let ctl = create ();;

let execute_query fd =
  begin
    let output v =
      let out_channel = out_channel_of_descr fd in
      output_value out_channel v;
      Pervasives.flush out_channel in
    try
      match input_value (Unix.in_channel_of_descr fdwith
        Get_day n ->
          read_protect ctl output (Day !agenda.(n))
      | Get_agenda ->
          read_protect ctl output (Agenda !agenda)
      | Add_event (name,day,start,finish,info) ->
          let add_event () =
            let event = (name,{start=startfinish=finishinfo=info}) in
            !agenda.(day) <- event::!agenda.(day) ;
            output Unit in
          write_protect ctl add_event ()
      | Delete_event (name,day) ->
          let delete_event () =
            !agenda.(day) <- List.remove_assoc name !agenda.(day);
            output Unit in
          write_protect ctl delete_event ()
    with
      e -> try
        output (Exception e)
      with _ ->
        Printf.eprintf "treatment error"flush Pervasives.stderr
  end;
  close fd;;
      
let thread_nb = 10;;

let main () =
  if Array.length Sys.argv <> 2 then
    begin
      prerr_endline ("Usage: "^Sys.argv.(0)^" port");
      exit 1
    end
  else
    try
      establish_fixed_thread_number_server thread_nb execute_query (port_of_string Sys.argv.(1))
    with Failure message ->
      prerr_endline message;
      exit 2;;

handle_unix_error main ()
      
open Unix;;
open Inet;;

type event = {start : intfinish : intinfo : string }
type day = (string*eventlist;;
type agenda = day array;;

type operation =
  | Get_agenda  (** demander les informations de tout l'agenda *)
  | Get_day of int (** demander les informations sur une journée *)
  | Add_event of string * int * int * int * string
        (** (nom, jour, heure début, heure fin, info) ajouter une entrée, le
           nom droit être unique le jour donné  *)

  | Delete_event of string * int
        (** (nom, jour) supprimer les informations de la journée donnée
           avec le nom donné *)
;;


type result =
  | Unit
  | Agenda of agenda
  | Day of day
  | Exception of exn;;

let remote_query address port (o : operation) =
  let sock = open_connection address port in
  let out_channel = out_channel_of_descr sock in
  output_value out_channel o;
  Pervasives.flush out_channel;
  let v = input_value (in_channel_of_descr sockin
  close sock;
  (v : result)
      
exception Bad_response_from_server;;

let server_address = (gethostbyname "localhost").h_addr_list.(0);;
let server_port = 8000;;

let remote_query q =
  match remote_query server_address server_port q with
    Exception e -> raise e
  | r -> r;;

let get_day j =
  match remote_query (Get_day jwith
    Day d -> d
  | _ -> raise Bad_response_from_server;;

let get_agenda () =
  match remote_query Get_agenda with
    Agenda a -> a
  |  _ -> raise Bad_response_from_server;;
  match remote_query Get_agenda with
    Agenda a -> a
  | _ -> raise Bad_response_from_server;;

let add_event name day start finish info =
  match remote_query (Add_event (name,day,start,finish,info)) with
    Unit -> ()
  | _ -> raise Bad_response_from_server;;

let delete_event name day =
   match remote_query (Delete_event (nameday)) with
     Unit -> ()
   | _ -> raise Bad_response_from_server;;
Écrire un programme client qui effectue des accès au calendrier. Par exemple, on pourra définir des suites d'appels aux fonctions distantes et lancer la suite dont le numéro est passé sur la ligne de commande.

(corrigé)
      
let print_event e =
  Printf.printf "%dh->%dh: %s" e.start e.finish e.info;
  print_newline ();;

let print_day d =
  List.iter
    (fun (s,e) ->
      Printf.printf "%s:" s;
      print_event e)
    d;;

let f_get_day n () =
  print_day (get_day n);;

let f_get_agenda () =
  let a = get_agenda () in
  for i = 0 to Array.length a - 1 do
    Printf.printf "[%d]:\n" i;
    print_day a.(i)
  done;
  flush Pervasives.stdout;;

let f_add_event name day start finish info ()=
  add_event name day start finish info ;
  Printf.printf "[%d] event %s added : " day name;
  print_event { start=start ; finish=finish ; info=info};;

let f_delete_event name day () =
  delete_event name day;
  Printf.printf "[%d] event %s deleted " day name;
  print_newline ();;

let suites =
  [|
    [
      f_get_agenda ;
      f_add_event "salon" 2 9 17 "salon de l'agriculture à Paris" ;
      f_get_day 2 ;
    ] ;
    [
      f_get_day 2 ;
      f_delete_event "salon" 2 ;
      f_get_agenda ;
    ] ;
  |]  ;;

let exec_f f =
  try f ()
  with
    Assert_failure _ as e -> raise e
  | e -> Printf.eprintf "Exception %s\n" (Printexc.to_string e)

let main () =
  if Array.length Sys.argv < 2 then
    begin
     Printf.eprintf "usage : %s <n>\n" Sys.argv.(0);
     flush Pervasives.stderr ;
     exit 1
    end
  else
    try
      List.iter exec_f suites.(int_of_string Sys.argv.(1))
    with _ ->
      (
       prerr_endline "suite de commandes non définie.";
       exit 2
      );;

handle_unix_error main ();;





Ce document a été traduit de LATEX par HEVEA