(* CS 2SC3 / SE 2S03 automated marking and testing functions -- Pouya Larjani *) open Students (* File system helpers *) let do_in_dir fd bd f = Sys.chdir fd; let r = f () in Sys.chdir bd; r let copy_files (s: student) ad fs = List.iter (fun f -> ignore (Sys.command ("cp " ^ f ^ " repos/" ^ s.macid ^ "/" ^ ad ^ "/"))) fs let ensure_dir l1 l2 l3 = (if l1 <> "" then try ignore (Sys.command ( "mkdir " ^ l1 ^ " > /dev/null 2> /dev/null" )) with _ -> ()); (if l2 <> "" then try ignore (Sys.command ( "mkdir " ^ l1 ^ "/" ^ l2 ^ " > /dev/null 2> /dev/null" )) with _ -> ()); (if l3 <> "" then try ignore (Sys.command ( "mkdir " ^ l1 ^ "/" ^ l2 ^ "/" ^ l3 ^ " > /dev/null 2> /dev/null" )) with _ -> ()) (* Output functions *) let outf: out_channel option ref = ref None let logt = ref "" let logf = ref true let res_open fn = outf := Some (open_out fn) let res_close () = match !outf with Some x -> flush x; close_out x; outf := None | None -> () let res_string x = print_string x; match !outf with Some f -> output_string f x | None -> () let res_newline x = res_string (x ^ "\n") let res_adjust x l = res_string (x ^ (String.make (l - String.length x) ' ')) let res_radjust x l = res_string ((String.make (l - String.length x) ' ') ^ x) let log_add x r = (if !logf then logt := !logt ^ " ! " ^ x ^ "\n"); r let log_write () = res_string !logt; logt := "" let log_enable t = logf := t let res_header (s: student) ad pe mark replyto = let name = (String.capitalize (String.lowercase s.first)) ^ " " ^ (String.capitalize (String.lowercase s.last)) in ensure_dir "marks" ad ""; res_open ("marks/" ^ ad ^ "/" ^ s.macid ^ ".txt"); res_newline ("Reply-to: " ^ replyto); res_newline ("Subject: [" ^ s.course ^ "] Assignment " ^ pe ^ " mark for " ^ name); res_newline ("To: " ^ s.macid ^ "@muss.cis.mcmaster.ca"); res_newline ("Content-type: text/html\n"); res_newline ""; res_newline "
";
    res_newline (String.make 80 '-');
    res_newline " CS 2SC3 / SE 2S03 Fall 2009";
    res_newline (" Name:        " ^ name);
    res_newline (" Student ID:  " ^ s.macid ^ "  (" ^ s.sid ^ ")");
    res_newline "";
    res_radjust (match mark with None -> "" | Some x -> string_of_int (if x<0 then 0 else x)) 5;
    res_adjust "/ 100" 5;
    res_newline ("    Assignment " ^ pe);
    res_newline ""

let res_footer () =
    res_newline (String.make 80 '-');
    res_newline "
"; res_close (); flush stdout let res_section name = res_adjust "" 15; res_newline name let res_mark name mark tot = res_radjust (match mark with None -> "" | Some x -> string_of_int x) 5; res_string "/"; res_radjust (string_of_int tot) 4; res_adjust "" 7; res_newline name; log_write () let attach_file s pe f = res_newline (String.make 80 '-'); res_newline (" Attachment: " ^ f); res_newline (String.make 80 '-'); try let inp = open_in ("repos/" ^ s.macid ^ "/" ^ pe ^ "/" ^ f) in (try while true do res_newline (input_line inp) done with _ -> ()); close_in inp; res_newline "" with _ -> res_newline "*** MISSING ***\n" let attach_files s pe fs = res_newline (String.make 80 '-'); res_newline "\nAttachments:\n"; List.iter (fun f -> attach_file s pe f) fs let send_email (s: student) ad = let file = "marks/" ^ ad ^ "/" ^ s.macid ^ ".txt" in try ignore (Sys.command ("/usr/sbin/sendmail -t < " ^ file)); print_string ("Sending email for " ^ file ^ "\n") with _ -> print_string ("FAILED Sending email for " ^ file ^ "\n") (* Checking functions *) let check_file_exists f = if not (Sys.file_exists f) then log_add ("Missing file: " ^ f) false else try if 0 = Sys.command("((0 < `du -b " ^ f ^ " | cut -c 1`))") then true else log_add ("Empty file: " ^ f) false with _ -> false let check_file_ontime d f = try if 0 = Sys.command( "((`date -d \"" ^ d ^ "\" +\"%Y%m%d%H%M%S\"` > `date -d \"\\`svn info " ^ f ^ " | grep Date | cut -c 20-\\`\" +\"%Y%m%d%H%M%S\"`))" ) then true else log_add ("Late file: " ^ f) false with _ -> false let check_file_compiles compiler f = try if 0 = Sys.command (compiler ^ " -c " ^ f ^ " > /dev/null 2> /dev/null") then true else log_add ("Compiler error: " ^ f) false with _ -> false let check_files_link linker output files = try if 0 = Sys.command ( linker ^ " -o " ^ output ^ (List.fold_left (fun s f -> s ^ " " ^ f) "" files) ^ " > /dev/null 2> /dev/null" ) then true else log_add ("Linking error: Bad function name or signature.") false with _ -> false let check_files (s: student) pe fs = ensure_dir "repos" s.macid pe; do_in_dir ("repos/" ^ s.macid ^ "/" ^ pe) "../../.." (fun () -> List.length (List.filter check_file_exists fs)) let check_ontime (s: student) pe date fs = do_in_dir ("repos/" ^ s.macid ^ "/" ^ pe) "../../.." (fun () -> List.length (List.filter (check_file_ontime date) fs)) let check_compiles (s: student) pe compiler fs = do_in_dir ("repos/" ^ s.macid ^ "/" ^ pe) "../../.." (fun () -> List.length (List.filter (check_file_compiles compiler) fs)) let run_cases (s: student) pe linker output fs ps = do_in_dir ("repos/" ^ s.macid ^ "/" ^ pe) "../../.." (fun () -> if not (check_files_link linker "autocompile" fs) then [] else List.map (fun p -> try Sys.command ("yes | ../../../limitexec autocompile " ^ p ^ " > " ^ output ^ " 2> /dev/null") with _ -> -1) ps) let check_runs s pe linker output fs = let r = run_cases s pe linker output fs [""] in if r = [] then -1 else List.hd r let check_output s pe output = log_enable false; let r = check_files s pe [output] in log_enable true; if r <= 0 then log_add "No program output detected." 0 else r let check_cases s pe linker output fs ps = let l = List.length ps in let r = run_cases s pe linker output fs ps in if r = [] then log_add "Could not run any test cases due to link error" (-1) else let ans = List.length (List.filter (fun x -> x = 1) r) in log_add ((string_of_int ans) ^ " out of " ^ (string_of_int l) ^ " test cases passed.") ans