diff options
Diffstat (limited to 'judge')
| -rw-r--r-- | judge/core.ml | 106 |
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 |