Improve judge, add NiAh player from AP.

1 files changed, 105 insertions, 1 deletions

diff --git a/judge/core.ml b/judge/core.ml
index 7012118..65a43a8 100644
--- a/judge/core.ml
+++ b/judge/core.ml
@@ -62,9 +62,12 @@ end
 module C (G: GAME) : CORE = struct
 	module G : GAME = G
 
+	exception Eliminated_ex
+
 	type player = {
 		name: string;
 		binary: string;
+		log_out: file_descr;
 		mutable score: int;
 	}
 
@@ -151,9 +154,15 @@ module C (G: GAME) : CORE = struct
 					if (st.st_kind = S_REG || st.st_kind = S_LNK)
 							&& (st.st_perm land 0o100 <> 0) then begin
 						Format.printf "- %s@." s;
+						(* open log output for player *)
+						let p_log_file = Filename.concat (Filename.concat !game_dir s) "stderr.log" in
+						let p_log_out = Unix.openfile p_log_file [O_APPEND; O_CREAT; O_WRONLY] 0o644 in
+						let f = Format.formatter_of_out_channel (out_channel_of_descr p_log_out) in
+						Format.fprintf f "---- Begin session %s@." date;
 						Hashtbl.add players	s
 							{ name = s;
 								binary = b;
+								log_out = p_log_out;
 								score = 0; }
 					end
 				with _ -> ();	
@@ -179,12 +188,15 @@ module C (G: GAME) : CORE = struct
 			Format.printf "Launching match: %s vs. %s@." p1 p2;
 
 			let open_c p =
+				let f =Format.formatter_of_out_channel (out_channel_of_descr p.log_out) in
+				Format.fprintf f "--- Begin game (%s vs. %s)@." p1 p2;
 				let (j2p_i, j2p_o) = pipe () in
 				let (p2j_i, p2j_o) = pipe () in
 				let pid = fork() in
 				if pid = 0 then begin
 					dup2 j2p_i stdin;
 					dup2 p2j_o stdout;
+					dup2 p.log_out stderr;
 					execv p.binary [| p.binary |];
 				end;
 				Format.printf "- %s: pid %d@." p.name pid;
@@ -204,6 +216,98 @@ module C (G: GAME) : CORE = struct
 
 		(* 2. LOOK IF ANYBODY IS TELLING US SOMETHING - IF SO, REACT
 					(wait max. 0.01 sec) *)
-		()
+		let in_fd = List.fold_left
+			(fun l g -> match g.s with
+				| Finished _ -> l
+				| _ ->
+					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)
+			[] !r_games
+		in
+		let in_fd, _, _ = select in_fd [] [] 0.01 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 op = match pi with P1 -> g.p2 | P2 -> g.p1 in
+			begin try match decode (input_line p.i), p.s with
+			| Hello x, Loading when x = G.id ->
+				p.s <- StandBy !game_time;
+				if op.s <> Loading then begin
+					match g.s, g.p1.s, g.p2.s with
+					| Initializing (TurnOf P1), StandBy t, _ ->
+						send_m g.p1 (YourTurn t);
+						g.p1.s <- Thinking (t, Unix.time());
+						g.s <- Running (TurnOf P1)
+					| Initializing (TurnOf P2), _, StandBy t ->
+						send_m g.p2 (YourTurn t);
+						g.p2.s <- Thinking (t, Unix.time());
+						g.s <- Running (TurnOf P2)
+					| _ -> assert false
+				end
+			| Play act, Thinking (time, beg_r) ->
+				let end_r = Unix.time () in
+				let new_s = G.turn g.g pi act in
+				begin match new_s with | Eliminated _ -> raise Eliminated_ex | _ -> () end;
+				send_m p OK;
+				send_m op (Play act);
+				let finished = match new_s with
+				| Tie ->
+					send_m p Tie;
+					send_m op Tie;
+					Format.printf "%s vs. %s: tie!@." g.p1.p.name g.p2.p.name;
+					true
+				| Won x when x = pi ->
+					send_m p YouWin;
+					send_m op YouLose;
+					Format.printf "%s vs. %s: %s wins!@." g.p1.p.name g.p2.p.name p.p.name;
+					true
+				| Won x ->
+					send_m op YouWin;
+					send_m p YouLose;
+					Format.printf "%s vs. %s: %s wins!@." g.p1.p.name g.p2.p.name op.p.name;
+					true
+				| TurnOf _ -> false
+				| Eliminated x -> assert false
+				in
+				if finished then begin
+					p.s <- Saving;
+					op.s <- Saving;
+					g.s <- Finished new_s
+				end else begin
+					p.s <- StandBy (time -. (end_r -. beg_r));
+					g.s <- Running new_s;
+					match op.s with
+						| StandBy t ->
+							send_m op (YourTurn t);
+							op.s <- Thinking (t, Unix.time())
+						| _ -> assert false
+				end
+			| FairEnough, Saving ->
+				kill p.pid 15;		(* 15 : sigterm *)
+				p.s <- Dead
+			| _ -> raise Eliminated_ex
+			| exception _ -> raise Eliminated_ex
+			with
+			| Eliminated_ex ->
+				send_m p Eliminated;
+				send_m op YouWin;
+				(* since process is not respecting the protocol, we cannot assume
+					it is doing anything reasonable, so we kill it... *)
+				kill p.pid 15;
+				Format.printf "%s vs. %s: %s eliminated!@." g.p1.p.name g.p2.p.name p.p.name;
+				p.s <- Dead;
+				op.s <- Saving;
+				g.s <- Finished (Eliminated pi)
+			end;
+		in List.iter do_fd in_fd
 	
 end