From 81f0d69813aecd22f3c1c24cf0fee35f8cfdf57b Mon Sep 17 00:00:00 2001
From: Alex AUVOLAT <alex.auvolat@ens.fr>
Date: Mon, 10 Nov 2014 14:38:06 +0100
Subject: Add file descriptor freeing.

---
 judge/core.ml | 49 +++++++++++++++++++++++--------------------------
 1 file changed, 23 insertions(+), 26 deletions(-)

(limited to 'judge/core.ml')

diff --git a/judge/core.ml b/judge/core.ml
index 2838732..ec73639 100644
--- a/judge/core.ml
+++ b/judge/core.ml
@@ -80,6 +80,7 @@ module Core (G: GAME) : CORE = struct
 
   and player_proc = {
     pid: int;
+    cfd: file_descr list;
     p: player;
     i: in_channel;
     o: out_channel;
@@ -218,11 +219,13 @@ module Core (G: GAME) : CORE = struct
         players)
       players
 
-  let send_m pp m =
-    let m = encode m in
-    if !log_games then Format.printf ">%s< %s@." pp.p.name m;
-    output_string pp.o (m ^ "\n");
-    flush pp.o
+  let send_m (pp : player_proc) m =
+    if pp.s <> Dead then begin
+      let m = encode m in
+      if !log_games then Format.printf ">%s< %s@." pp.p.name m;
+      output_string pp.o (m ^ "\n");
+      flush pp.o
+    end
 
   let handle_events () =
     (* 1. IF NOT ENOUGH MATCHES ARE RUNING, LAUNCH ONE *)
@@ -251,6 +254,7 @@ module Core (G: GAME) : CORE = struct
         let pl = { pid; p;
           i = in_channel_of_descr p2j_i;
           o = out_channel_of_descr j2p_o;
+          cfd = [p2j_i; p2j_o; j2p_i; j2p_o];
           s = Loading } in
         p.running <- Some pl;
         send_m pl (Hello G.id);
@@ -276,29 +280,21 @@ module Core (G: GAME) : CORE = struct
     end;
     (* 2. LOOK IF ANYBODY IS TELLING US SOMETHING - IF SO, REACT
           (wait max. 0.01 sec) *)
-    let in_fd = List.fold_left
+    let in_fd_x = List.fold_left
       (fun l g ->
-        let l = match g.p1.s with
-          | Dead -> l
-          | _ -> (Unix.descr_of_in_channel g.p1.i)::l
-        in match g.p2.s with
-          | Dead -> l
-          | _ -> (Unix.descr_of_in_channel g.p2.i)::l)
+        let l = if g.p1.s = Dead then l
+          else (Unix.descr_of_in_channel g.p1.i, (g, g.p1))::l
+        in if g.p2.s = Dead then l
+          else (Unix.descr_of_in_channel g.p2.i, (g, g.p2))::l)
       [] !r_games
     in
     let in_fd, _, _ =
-      try select in_fd [] [] 0.01
-      with 
-        Unix_error (EINTR, _, _) -> [], [], []
+      try select (List.map fst in_fd_x) [] [] 0.01
+      with Unix_error (EINTR, _, _) -> [], [], []
     in
     let do_fd fd =
-      let g = List.find
-        (fun g -> fd = Unix.descr_of_in_channel g.p1.i
-            || fd = Unix.descr_of_in_channel g.p2.i)
-        !r_games
-      in
-      let pi = if Unix.descr_of_in_channel g.p1.i = fd then P1 else P2 in
-      let p = match pi with P1 -> g.p1 | P2 -> g.p2 in
+      let (g, p) = List.assoc fd in_fd_x in
+      let pi = if p == g.p1 then P1 else P2 in
       let op = match pi with P1 -> g.p2 | P2 -> g.p1 in
       begin try
         let l = input_line p.i in
@@ -339,7 +335,7 @@ module Core (G: GAME) : CORE = struct
           in
           if finished then begin
             p.s <- Saving;
-            op.s <- Saving;
+            if op.s <> Dead then op.s <- Saving;
           end
         | FairEnough, Saving ->
           kill p.pid Sys.sigterm;
@@ -357,7 +353,7 @@ module Core (G: GAME) : CORE = struct
           kill p.pid Sys.sigterm;
           Format.printf "%s vs. %s: %s eliminated (%s)!@." g.p1.p.name g.p2.p.name p.p.name r;
           p.p.score <- p.p.score + !pt_elim;
-          op.s <- Saving;
+          if op.s <> Dead then op.s <- Saving;
           p.s <- Saving;
           g.s <- Eliminated pi
       end;
@@ -381,7 +377,7 @@ module Core (G: GAME) : CORE = struct
           w.p.score <- w.p.score + !pt_win;
           l.p.score <- l.p.score + !pt_lose;
           w.s <- Saving;
-          l.s <- Saving
+          if l.s <> Dead then l.s <- Saving
         end
       | _ -> ()
     in List.iter check_timeout !r_games;
@@ -403,11 +399,12 @@ module Core (G: GAME) : CORE = struct
             send_m op YouWin;
             Format.printf "%s vs. %s: %s eliminated (died...)!@." g.p1.p.name g.p2.p.name p.p.name;
             p.p.score <- p.p.score + !pt_elim;
-            op.s <- Saving;
+            if op.s <> Dead then op.s <- Saving;
             g.s <- Eliminated pi
           end;
           p.s <- Dead;
           p.p.running <- None;
+          List.iter close p.cfd;
       end
     with _ -> () end
   
-- 
cgit v1.2.3