evaluator.ml 1.62 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37
exception Timeout

let header = "Content-Type: text/plain\n\n"

let cut w s =
  let b= Buffer.create 1024 in
  let rec aux i x =
    if i < String.length s then
      match s.[i] with
	| '\n' -> Buffer.add_char b '\n'; aux (i + 1) 0
	| '\r' -> aux (i + 1) 0
	| '<' ->
	    let rec tag i =
	      Buffer.add_char b s.[i];
	      if (s.[i] = '>') then aux (i + 1) x else tag (i + 1) in
	    tag i
	| c -> 
	    let x = 
	      if x = w then (Buffer.add_string b "\\\n:"; 2) 
	      else (x + 1) in
	    Buffer.add_char b c; 
	    if c = '&' then
	      let rec ent i =
		Buffer.add_char b s.[i];
		if (s.[i] = ';') then aux (i + 1) x else ent (i + 1) in
	      ent (i + 1)
	    else
	      aux (i + 1) x
  in
  aux 0 0;
  Buffer.contents b

let () =
  let exec src =
    ignore (Unix.alarm 10);
    Sys.set_signal Sys.sigalrm 
      (Sys.Signal_handle (fun _ -> raise (Cduce.Escape Timeout)));
38 39
    let v = Location.get_viewport () in
    let ppf = Html.ppf v 
40
    and input = Stream.of_string src in
41
    Format.pp_set_margin ppf 60;
42 43
    Location.push_source (`String src);
    Location.set_protected true;
44
    Config.init_all ();
45 46
    let ok = Cduce.script ppf ppf input in
    if ok then Format.fprintf ppf "@\nOk.@\n";
47
    Html.get v
48 49
  in

50
  Location.set_viewport (Html.create true);
51 52 53 54 55
  let prog = Buffer.create 1024 in
  (try while true do Buffer.add_string prog (read_line ()); Buffer.add_string prog "\n" done;
   with End_of_file -> ());
  let prog = Buffer.contents prog in
  let res = try exec prog with Timeout -> "Timeout reached !" in
56
  let res = cut 60 res in
57
  print_string header;
58 59 60 61
  print_endline "<pre>";
  print_endline res;
  print_endline "</pre>"