Skip to content
Browse files

irc client server

  • Loading branch information...
1 parent 5c3f660 commit 1d013cce4020eaeca8d2d17aab55d9ee9f7a5be9 @SylvainGBR committed Jun 8, 2012
Showing with 398 additions and 0 deletions.
  1. +63 −0 actors.ml
  2. +75 −0 client.ml
  3. +165 −0 server.ml
  4. +95 −0 test.ml
View
63 actors.ml
@@ -0,0 +1,63 @@
+type arg =
+ | Actor of actor
+
+ | C of char
+ | S of string
+ | I of int
+ | F of float
+
+ | L of arg list
+ | A of arg array
+ | D of (string * arg) list
+
+ | LC of char list
+ | LS of string list
+ | LI of int list
+ | LF of float list
+
+ | AC of char array
+ | AS of string array
+ | AI of int array
+ | AF of float array
+
+and message = string * arg list
+
+and local_actor = {
+ mailbox : message My_queue.t;
+ mutex : Mutex.t;
+}
+
+and remote_actor = {
+ actor_host : string;
+ actor_node : int; (* uniq identifier of the machine on which it was created (20-byte string generated randomly at startup) *)
+ (* remote_ip : string; *)
+ (* remote_port : int; *)
+}
+
+and location =
+ | Local of local_actor
+ | Remote of remote_actor
+
+and actor = {
+ actor_id : int; (* local number of the actor when it was created *)
+ actor_location : location;
+}
+
+let print_actor a =
+ match a.actor_location with
+ | Local lac -> Printf.printf "Local %n; \n%!" a.actor_id;
+ | Remote rma -> Printf.printf "Remote %s %n %n; \n%!" rma.actor_host rma.actor_node a.actor_id;;
+
+let print_message (st, li) =
+ Printf.printf "( %s, " st;
+ Printf.printf "[";
+ let rec print_arg_list al =
+ match al with
+ | [] -> Printf.printf "])\n%!";
+ | (Actor a) :: q -> print_actor a; print_arg_list q;
+ | (C c) :: q -> Printf.printf "C %c; " c; print_arg_list q;
+ | (S s) :: q -> Printf.printf "S %s; " s; print_arg_list q;
+ | (I i) :: q -> Printf.printf "I %n; " i; print_arg_list q;
+ | (F f) :: q -> Printf.printf "F %f; " f; print_arg_list q;
+ | _ :: q -> Printf.printf "***; "; print_arg_list q in
+ print_arg_list li;;
View
75 client.ml
@@ -0,0 +1,75 @@
+open Sys;;
+open Unix;;
+open Actors;;
+open Actorssg;;
+
+Printf.printf "Local Node : %n\n%!" local_node;
+let ac = create() in
+let nod = client "193.55.250.242" in
+nodes_display();
+Printf.printf "Noeud distant : %n\n%!" nod.name;
+
+let rec f a =
+ react (g a);
+and g a m =
+ match m with
+ |("ping", [I i]) -> Printf.printf "Ping %n\n%!" i;
+ send a ("pong", [I i]); f a;
+ | _ -> Printf.printf "pas bon"; f a in
+
+let aaac = create() in
+let irct = create() in
+Printf.printf "\nEnter your name : \n%!";
+let pseudo = input_line (in_channel_of_descr stdin) in
+
+let rec irc_talk rem =
+ let s = input_line (in_channel_of_descr stdin) in
+ (* print_actor rem; Printf.printf "You Wrote : %s \n%!" s; *)
+ send rem ("post", [S s; S pseudo]);
+ irc_talk rem in
+
+(* let rec funtest rem = *)
+(* let s = input_line (in_channel_of_descr stdin) in *)
+(* Printf.printf "You Wrote : %s \n%!" s; *)
+(* print_actor rem; *)
+(* send rem ("post", [S s]); *)
+(* funtest rem in *)
+
+let irc_connect() =
+
+ let rec display() =
+ let display_aux m =
+ match m with
+ | ("post", [S s; S g]) -> Printf.printf "<%s> : %s \n%!" g s; display()
+ | _ -> Printf.printf "Wrong return message %!"; print_message m; display() in
+ react display_aux in
+
+ let rec wait_validation m =
+ match m with
+ | ("connected", (Actor a) :: q) -> Printf.printf "Connected ! \n%!";
+ let _ = Thread.create irc_talk a in
+ (* let _ = Thread.create funtest a in Printf.printf "fdvfezgfdzf\n%!"; *)
+ display()
+ | _ -> react wait_validation
+
+ in react wait_validation in
+
+let rec test() =
+ react gt;
+and gt m =
+ match m with
+ |("retour", [S "bonjour"; Actor a]) -> Printf.printf "bonjour : ";
+ print_actor a; send a ("bonjour", [S "siri"]); test();
+ |("retour", [S "pipong"; Actor a]) -> Printf.printf "pipong : ";
+ print_actor a; start ac (fun () -> f a); send a ("pong", [I 0]); test();
+ |("retour", [S "irc_connections"; Actor a]) -> send a ("join", [S pseudo; Actor irct]);
+ start irct irc_connect; Printf.printf "Irc Server : %!"; print_actor a;
+ test()
+ | _ -> Printf.printf "Wrong return message "; print_message m; test() in
+
+start aaac test;
+(* start_remote "pipong" "127.0.0.1" nod.name aaac [Actor ac]; *)
+(* start_remote "bonjour" "127.0.0.1" nod.name aaac []; *)
+(* start_remote "irc_connections" "127.0.0.1" nod.name aaac []; *)
+exec_remote "irc" "127.0.0.1" nod.name [Actor aaac];
+receive_handler();;
View
165 server.ml
@@ -0,0 +1,165 @@
+open Sys;;
+open Unix;;
+open Actors;;
+open Actorssg;;
+
+let rec bonjour q =
+ react bj
+and bj m =
+ match m with
+ | ("bonjour", [S s]) -> Printf.printf "%s\n%!" s; bonjour [];
+ | _ -> Printf.printf "Wrong Message"; bonjour [];;
+
+let treat_connect i o client =
+ let s = input_value i in
+ (* mutex_lock n_mutex; *)
+ if (Hashtbl.mem nodes s) then begin Printf.printf "This node already exists\n%!"; close_out o;
+ (* mutex_unlock n_mutex *) end
+ else begin output_value o local_node;
+ flush o;
+ let ac = create() in
+ let t = Thread.create receive_remote (i, s) in
+ let hst = {name = s; agent = ac; support = t} in
+ Hashtbl.add nodes s hst;
+ start ac (fun() -> sender o);
+ actors_display();
+ nodes_display();
+ Printf.printf "Noeud distant : %n\n%!" hst.name end;;
+(* mutex_unlock n_mutex;; *)
+
+let rec restart_on_EINTR f x =
+ try f x with Unix_error (EINTR, _, _) -> restart_on_EINTR f x;;
+
+let install_tcp_server_socket addr =
+ let s = socket PF_INET SOCK_STREAM 0 in
+ try
+ bind s addr;
+ listen s 10;
+ s
+ with z -> close s; raise z;;
+
+let tcp_server treat_connection addr =
+ let rec run s =
+ let client = restart_on_EINTR accept s in
+ let _ = Thread.create treat_connection client in
+ run s in
+ ignore (signal sigpipe Signal_ignore);
+ let server_sock = install_tcp_server_socket addr in
+ run server_sock;;
+
+let server () =
+ (* Random.init (int_of_float (Unix.time())); *)
+ (* local_node := (!local_node) ^ string_of_int (Random.int 1024); *)
+ Printf.printf "Local Node : %n\n%!" local_node;
+ let port = 4242 in
+ (* let host = (gethostbyname(gethostname())).h_addr_list.(0) in *)
+ (* let host = (gethostbyname "127.0.0.1").h_addr_list.(0) in *)
+ let host = (gethostbyname "193.55.250.242").h_addr_list.(0) in
+ let addr = ADDR_INET (host, port) in
+ let treat (client_sock, client_addr as client) =
+ (* log information *)
+ begin match client_addr with
+ ADDR_INET(caller, _) ->
+ prerr_endline ("Connection from " ^ string_of_inet_addr caller);
+ | ADDR_UNIX _ ->
+ prerr_endline "Connection from the Unix domain (???)";
+ end;
+ (* connection treatment *)
+ treat_connect (in_channel_of_descr client_sock) (out_channel_of_descr client_sock) client in
+ Thread.create (tcp_server treat) addr;;
+
+let _ = handle_unix_error server () in
+Hashtbl.add functions "bonjour" bonjour ;
+
+let rec pipong l =
+ let gs ar m =
+ match (ar, m) with
+ |(Actor a, ("pong", [I i])) -> Printf.printf "Pong %n\n%!" i;
+ send a ("ping", [I (i+1)]);
+ pipong [ar];
+ |( x , ("pong", [I i])) -> Printf.printf "Invalid Argument"
+ | ( _ , (s, _)) -> Printf.printf "pas bon : %s\n%!" s; pipong [ar] in
+ react (gs (List.hd l)) in
+
+Hashtbl.add functions "pipong" pipong ;
+
+let irc_mutex = Mutex.create() in
+let irc_on = ref false in
+let irc_act = ref creator in
+
+let irc_connections l =
+ let connec = Hashtbl.create 13 in
+
+ (* let users_display() = *)
+ (* Printf.printf "Users : "; *)
+ (* let f a b c = Printf.printf "%s; %!" a; c in *)
+ (* Hashtbl.fold f connec (); *)
+ (* Printf.printf "\n%!" in *)
+
+ let ac = create() in
+ Mutex.unlock irc_mutex;
+ Hashtbl.add connec "server" ("server", ac);
+ let rec irc_server() =
+ (* users_display(); *)
+ let ircm (h, l) =
+ let spread a b =
+ match b with
+ | ("server", _ ) -> (match l with
+ | [S s; S g] -> Printf.printf "<%s> : %s \n%!" g s
+ | _ -> failwith "Wrong Message Type Error in irc_connections");
+ | ( s , a ) -> (* Printf.printf "Talking to : %s, " s; print_actor a; *) send a ("post", l) in
+ match (h, l) with
+ | ("post", [S s; S st]) -> Hashtbl.iter spread connec; irc_server();
+ (* | ("post", [S s; S st]) -> let (nam, orig) = Hashtbl.find connec st in *)
+ (* send orig ("post", [S s; S st]); irc_server(); *)
+ | _ -> irc_server() in
+ react ircm in
+ start ac irc_server;
+ let rec connexion_handler() =
+ let connexion_request m =
+
+ (* let send_connected a b lst = (\*Creates a list containing all the people connected*\) *)
+ (* match b with *)
+ (* | (s, a) -> (S s) :: (Actor a) :: lst in *)
+
+ match m with
+ | ("join", [S s; Actor a]) -> (* let lis = Hashtbl.fold send_connected connec [] in *)
+ Hashtbl.add connec s (s, a);
+ (* send a ("connected", lis); *)
+ send a ("connected", [Actor ac]);
+ connexion_handler();
+ | _ -> Printf.printf "Wrong Message in connexion_request\n%!";
+ connexion_handler() in
+ react connexion_request in
+ connexion_handler() in
+
+Hashtbl.add functions "irc_connections" irc_connections;
+
+let transit_act = create() in
+
+let trans a =
+ let tran m =
+ match m with
+ | ("retour", [S s; Actor ac]) -> irc_act:= ac; send a ("retour", [S s; Actor ac]);
+ | _ -> () in
+ react tran in
+
+let irc q =
+ Mutex.lock irc_mutex;
+ match q with
+ | [Actor ac] -> Printf.printf "Irc_on : %b\n%!" (!irc_on);
+ if (!irc_on = false) then begin
+ irc_on := true;
+ start transit_act (fun ()-> trans ac);
+ send creator ("start", [S "irc_connections"; Actor transit_act]) end
+ else begin
+ print_actor (!irc_act);
+ send ac ("retour", [S "irc_connections"; Actor (!irc_act)]);
+ Mutex.unlock irc_mutex end
+ | _ -> Mutex.unlock irc_mutex in
+
+Hashtbl.add functions "irc" irc;
+
+start creator host_actor;
+actors_display();
+receive_handler();;
View
95 test.ml
@@ -0,0 +1,95 @@
+open Actors
+open Actorssg
+
+let ping_pong() =
+ let act1 = create() in
+ (* let act2 = create() in *)
+ let rec ping() =
+ react pig
+ and pig m =
+ let (s, l) = m in
+ if (s = "ping") then begin print_string "ping";
+ (match l with
+ | (Actor a) :: (I i) :: q -> Printf.printf " : %d\n%!" i;
+ send a ("pong", (Actor act1) :: (I (i + 1)) :: []);
+ | _ -> raise NotHandled) ;
+ ping() end in
+ let rec pong() =
+ react pog
+ and pog m =
+ let (s, l) = m in
+ if (s = "pong") then begin print_string "pong";
+ (match l with
+ | (Actor a) :: (I i) :: q -> Printf.printf " : %d\n%!" i;
+ (* send a ("ping", (Actor act2) :: (I (i + 1)) :: []); *)
+ send a ("ping", (Actor act1) :: (I (i + 1)) :: []);
+ | _ -> raise NotHandled) ;
+ pong() end
+ in begin
+ start act1 ping;
+ (* start act2 pong; *)
+ start act1 pong;
+ (* send act1 ("ping", (Actor act2) :: (I 1) :: []); *)
+ send act1 ("ping", (Actor act1) :: (I 1) :: []);
+ receive_handler();
+ end;;
+
+ping_pong();;
+
+let calcul_pi n s =
+ let t = Sys.time() in
+ let main_act = create() in
+ let slave() =
+ let slv m =
+ let (str, l) = m in
+ match l with
+ | (Actor a) :: (I k) :: (I n) :: (I s) :: q -> let res = ref 0.0 in begin
+ for i = k * n / s + 1 to (k + 1) * n / s do
+ let r = (float_of_int i -. 0.5) /. float_of_int n in
+ res := (!res) +. 1. /. (1. +. r *. r);
+ done;
+ send a ("pi", (F (!res)) :: []) end
+ | _ -> raise NotHandled
+ in
+ react slv
+ in
+ let master() =
+ let compteur = ref 1 in
+ let res = ref 0.0 in
+ let rec act() =
+ react mlisten
+ and mlisten m =
+ let (str, l) = m in
+ match l with
+ | (F r) :: q -> res := (!res) +. r;
+ if (!compteur = s) then Printf.printf "*** %f ***\n %!" (4. *. !res /. float_of_int n)
+ else begin debug "Recu %d%!" (!compteur);
+ incr compteur;
+ act() end;
+ | _ -> raise NotHandled
+ in act()
+ in
+ start main_act master;
+ for k = 0 to s-1 do
+ let ac = create() in begin
+ start ac slave;
+ send ac ("pi", (Actor main_act) :: (I k) :: (I n) :: (I s) :: []);
+ debug "Sent pi_request to %d \n %!" k
+ end
+ done;
+ receive_handler();
+ Printf.printf "*** Time : %f ***\n %!" (Sys.time() -. t);;
+
+(* calcul_pi 30000000 1;; *)
+
+let calcul_picpu n =
+ let t = Sys.time() in
+ let res = ref 0.0 in
+ for i = 1 to n do
+ let r = (float_of_int i -. 0.5) /. float_of_int n in
+ res := (!res) +. 1. /. (1. +. r *. r)
+ done;
+ Printf.printf "*** CPU : %f ***\n%!" (4. *. !res /. float_of_int n);
+ Printf.printf "*** Time : %f ***\n %!" (Sys.time() -. t);;
+
+(* calcul_picpu 30000000;; *)

0 comments on commit 1d013cc

Please sign in to comment.
Something went wrong with that request. Please try again.