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;; |