Mardi 7 mars 2006 |
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:
sigstop
pour arrêter et relancer le serveur).open Unix;; val run_iterative_server : (file_descr -> unit) -> file_descr -> unit |
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.
val treat_connection : file_descr -> unit |
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.)
val open_server : inet_addr -> int -> file_descr |
socket
sur laquelle il peut
accepter les connections.
val establish_iterative_server : inet_addr -> int -> unit |
val run_iterative_server : (file_descr -> unit) -> file_descr list -> unit |
run_iterative_server
mais attend des connections sur
l'une quelconque des prises reçues en second argument.
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.)open Sys;; open Unix;; open Inet;; let try_finalize f x finally y = let res = try f x with exn -> finally y; raise 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_connection, client_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 ();; |
type event = {start : int; finish : int; info : string } type day = (string*event) list;; 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;; |
input_value
et
output_value
sur des in_channel
et un out_channel
construit
autour du descripteur de prise.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 fd) with 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=start; finish=finish; info=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 : int; finish : int; info : string } type day = (string*event) list;; 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 sock) in 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 j) with 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 (name, day)) with Unit -> () | _ -> raise Bad_response_from_server;; |
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