matitaB/matita/matitadaemon.ml

   1 open Printf;;
   2 open Http_types;;
   3
   4 module Stack = Continuationals.Stack
   5
   6 let rt_path () = Helm_registry.get "matita.rt_base_dir"
   7
   8 let libdir uid = (rt_path ()) ^ "/users/" ^ uid
   9
  10 let utf8_length = Netconversion.ustring_length `Enc_utf8
  11
  12 let utf8_parsed_text s floc =
  13   let start, stop = HExtlib.loc_of_floc floc in
  14   let len = stop - start in
  15   let res = Netconversion.ustring_sub `Enc_utf8 start len s in
  16   res, String.length res
  17
  18 (*** from matitaScript.ml ***)
  19 (* let only_dust_RE = Pcre.regexp "^(\\s|\n|%%[^\n]*\n)*$" *)
  20
  21 let eval_statement include_paths (* (buffer : GText.buffer) *) status (* script *)
  22  statement
  23 =
  24   let ast,unparsed_text =
  25     match statement with
  26     | `Raw text ->
  27         (* if Pcre.pmatch ~rex:only_dust_RE text then raise Margin; *)
  28         let strm =
  29          GrafiteParser.parsable_statement status
  30           (Ulexing.from_utf8_string text) in
  31         let ast = MatitaEngine.get_ast status include_paths strm in
  32          ast, text
  33     | `Ast (st, text) -> st, text
  34   in
  35   let floc = match ast with
  36   | GrafiteAst.Executable (loc, _)
  37   | GrafiteAst.Comment (loc, _) -> loc in
  38
  39   let _,lend = HExtlib.loc_of_floc floc in
  40   let parsed_text, _parsed_text_len =
  41     utf8_parsed_text unparsed_text (HExtlib.floc_of_loc (0,lend)) in
  42   let byte_parsed_text_len = String.length parsed_text in
  43   let unparsed_txt' =
  44     String.sub unparsed_text byte_parsed_text_len
  45       (String.length unparsed_text - byte_parsed_text_len)
  46   in
  47
  48   let status =
  49     MatitaEngine.eval_ast ~include_paths ~do_heavy_checks:false status ("",0,ast)
  50   in
  51   (status, parsed_text, unparsed_txt'),"",(*parsed_text_len*)
  52     utf8_length parsed_text
  53
  54 let sequent_size = ref 40;;
  55
  56 let include_paths = ref [];;
  57
  58 (* <metasenv>
  59  *   <meta number="...">
  60  *     <metaname>...</metaname>
  61  *     <goal>...</goal>
  62  *   </meta>
  63  *
  64  *   ...
  65  * </metasenv> *)
  66 let output_status s =
  67   let _,_,metasenv,subst,_ = s#obj in
  68   let render_switch = function
  69   | Stack.Open i -> "?" ^ (string_of_int i)
  70   | Stack.Closed i -> "<S>?" ^ (string_of_int i) ^ "</S>"
  71   in
  72   let int_of_switch = function
  73   | Stack.Open i | Stack.Closed i -> i
  74   in
  75   let sequent = function
  76   | Stack.Open i ->
  77       let meta = List.assoc i metasenv in
  78       snd (ApplyTransformation.ntxt_of_cic_sequent
  79         ~metasenv ~subst ~map_unicode_to_tex:false !sequent_size s (i,meta))
  80   | Stack.Closed _ -> "This goal has already been closed."
  81   in
  82   let render_sequent is_loc acc depth tag (pos,sw) =
  83     let metano = int_of_switch sw in
  84     let markup =
  85       if is_loc then
  86         (match depth, pos with
  87          | 0, 0 -> "<B>" ^ (render_switch sw) ^ "</B>"
  88          | 0, _ ->
  89             Printf.sprintf "<B>|<SUB>%d</SUB>: %s</B>" pos (render_switch sw)
  90          | 1, pos when Stack.head_tag s#stack = `BranchTag ->
  91              Printf.sprintf "|<SUB>%d</SUB> : %s" pos (render_switch sw)
  92          | _ -> render_switch sw)
  93       else render_switch sw
  94     in
  95     prerr_endline "pippo1";
  96     let markup =
  97       Netencoding.Html.encode ~in_enc:`Enc_utf8 ~prefer_name:false () markup in
  98     let markup = "<metaname>" ^ markup ^ "</metaname>" in
  99     prerr_endline "pippo2";
 100     let sequent =
 101       Netencoding.Html.encode ~in_enc:`Enc_utf8 ~prefer_name:false () (sequent sw)
 102     in
 103     let txt0 = "<goal>" ^ sequent ^ "</goal>" in
 104     "<meta number=\"" ^ (string_of_int metano) ^ "\">" ^ markup ^
 105     txt0 ^ "</meta>" ^ acc
 106   in
 107   let res = "<metasenv>" ^
 108     (Stack.fold
 109       ~env:(render_sequent true) ~cont:(render_sequent false)
 110       ~todo:(render_sequent false) "" s#stack) ^
 111     "</metasenv>"
 112   in
 113   prerr_endline ("sending metasenv:\n" ^ res); res
 114 ;;
 115
 116 (* let html_of_status s =
 117   let _,_,metasenv,subst,_ = s#obj in
 118   let txt = List.fold_left
 119     (fun acc (nmeta,_ as meta) ->
 120        let txt0 = snd (ApplyTransformation.ntxt_of_cic_sequent
 121          ~metasenv ~subst ~map_unicode_to_tex:false 80 s meta)
 122        in
 123        prerr_endline ("### txt0 = " ^ txt0);
 124       ("<B>Goal ?" ^ (string_of_int nmeta) ^ "</B>\n" ^ txt0)::acc)
 125     [] metasenv
 126   in
 127   String.concat "\n\n" txt
 128 ;; *)
 129
 130 let heading_nl_RE = Pcre.regexp "^\\s*\n\\s*";;
 131
 132 let first_line s =
 133   let s = Pcre.replace ~rex:heading_nl_RE s in
 134   try
 135     let nl_pos = String.index s '\n' in
 136     String.sub s 0 nl_pos
 137   with Not_found -> s
 138 ;;
 139
 140 let read_file fname =
 141   let chan = open_in fname in
 142   let lines = ref [] in
 143   (try
 144      while true do
 145        lines := input_line chan :: !lines
 146      done;
 147    with End_of_file -> close_in chan);
 148   String.concat "\n" (List.rev !lines)
 149 ;;
 150
 151 let load_index outchan =
 152   let s = read_file "index.html" in
 153   Http_daemon.respond ~headers:["Content-Type", "text/html"] ~code:(`Code 200) ~body:s outchan
 154 ;;
 155
 156 let load_doc filename outchan =
 157   let s = read_file filename in
 158   let is_png =
 159     try String.sub filename (String.length filename - 4) 4 = ".png"
 160     with Invalid_argument _ -> false
 161   in
 162   let contenttype = if is_png then "image/png" else "text/html" in
 163   Http_daemon.respond ~headers:["Content-Type", contenttype] ~code:(`Code 200) ~body:s outchan
 164 ;;
 165
 166 let retrieve (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
 167   let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
 168   let env = cgi#environment in
 169   (try
 170     let sid = Uuidm.of_string (Netcgi.Cookie.value (env#cookie "session")) in
 171     let sid = HExtlib.unopt sid in
 172     let uid = MatitaAuthentication.user_of_session sid in
 173     cgi # set_header
 174       ~cache:`No_cache
 175       ~content_type:"text/xml; charset=\"utf-8\""
 176       ();
 177     let filename = libdir uid ^ "/" ^ (cgi # argument_value "file") in
 178     prerr_endline ("reading file " ^ filename);
 179     let body =
 180       Netencoding.Html.encode ~in_enc:`Enc_utf8 ~prefer_name:false ()
 181         (read_file filename) in
 182     prerr_endline ("sending:\nBEGIN\n" ^ body ^ "\nEND");
 183     let body = "<file>" ^ body ^ "</file>" in
 184     let baseuri, incpaths =
 185       try
 186         let root, baseuri, _fname, _tgt =
 187           Librarian.baseuri_of_script ~include_paths:[] filename in
 188         let includes =
 189          try
 190           Str.split (Str.regexp " ")
 191            (List.assoc "include_paths" (Librarian.load_root_file (root^"/root")))
 192          with Not_found -> []
 193         in
 194         let rc = root :: includes in
 195          List.iter (HLog.debug) rc; baseuri, rc
 196        with
 197          Librarian.NoRootFor _ | Librarian.FileNotFound _ -> "",[] in
 198     include_paths := incpaths;
 199     let status = MatitaAuthentication.get_status sid in
 200     MatitaAuthentication.set_status sid (status#set_baseuri baseuri);
 201     cgi#out_channel#output_string body;
 202   with
 203   | Not_found _ ->
 204     cgi # set_header
 205       ~status:`Internal_server_error
 206       ~cache:`No_cache
 207       ~content_type:"text/xml; charset=\"utf-8\""
 208       ());
 209   cgi#out_channel#commit_work()
 210 ;;
 211
 212 let advance0 sid text =
 213   let status = MatitaAuthentication.get_status sid in
 214   let history = MatitaAuthentication.get_history sid in
 215   let (st,new_statements,new_unparsed),(* newtext TODO *) _,parsed_len =
 216        (* try *)
 217          eval_statement !include_paths (*buffer*) status (`Raw text)
 218        (* with End_of_file -> raise Margin *)
 219      in
 220   MatitaAuthentication.set_status sid st;
 221   MatitaAuthentication.set_history sid (st::history);
 222   parsed_len, new_unparsed, st
 223
 224 let register (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
 225   let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
 226   let env = cgi#environment in
 227
 228   assert (cgi#arguments <> []);
 229   let uid = cgi#argument_value "userid" in
 230   let userpw = cgi#argument_value "password" in
 231   (try
 232     MatitaAuthentication.add_user uid userpw;
 233     env#set_output_header_field "Location" "/index.html"
 234    with
 235    | MatitaAuthentication.UsernameCollision _ ->
 236       cgi#set_header
 237        ~cache:`No_cache
 238        ~content_type:"text/html; charset=\"utf-8\""
 239        ();
 240      cgi#out_channel#output_string
 241       "<html><head></head><body>Error: User id collision!</body></html>"
 242    | MatitaFilesystem.SvnError msg ->
 243       cgi#set_header
 244        ~cache:`No_cache
 245        ~content_type:"text/html; charset=\"utf-8\""
 246        ();
 247      cgi#out_channel#output_string
 248       ("<html><head></head><body><p>Error: Svn checkout failed!<p><p><textarea>"
 249        ^ msg ^ "</textarea></p></body></html>"));
 250   cgi#out_channel#commit_work()
 251 ;;
 252
 253 let login (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
 254   let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
 255   let env = cgi#environment in
 256
 257   assert (cgi#arguments <> []);
 258   let uid = cgi#argument_value "userid" in
 259   let userpw = cgi#argument_value "password" in
 260   let pw,_ = MatitaAuthentication.lookup_user uid in
 261
 262   if pw = userpw then
 263    begin
 264     let _ = MatitaFilesystem.html_of_library uid in
 265     let sid = MatitaAuthentication.create_session uid in
 266     (* let cookie = Netcgi.Cookie.make "session" (Uuidm.to_string sid) in
 267        cgi#set_header ~set_cookies:[cookie] (); *)
 268     env#set_output_header_field
 269       "Set-Cookie" ("session=" ^ (Uuidm.to_string sid));
 270     env#set_output_header_field "Location" "/index.html"
 271    end
 272   else
 273    begin
 274     prerr_endline ("ERROR: received " ^ userpw ^ "but the password is " ^ pw);
 275     cgi#set_header
 276       ~cache:`No_cache
 277       ~content_type:"text/html; charset=\"utf-8\""
 278       ();
 279     cgi#out_channel#output_string
 280       "<html><head></head><body>Authentication error</body></html>"
 281    end;
 282
 283   cgi#out_channel#commit_work()
 284
 285 ;;
 286
 287 let logout (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
 288   let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
 289   let env = cgi#environment in
 290   (try
 291     let sid = Uuidm.of_string (Netcgi.Cookie.value (env#cookie "session")) in
 292     let sid = HExtlib.unopt sid in
 293     MatitaAuthentication.logout_user sid;
 294     cgi # set_header
 295       ~cache:`No_cache
 296       ~content_type:"text/html; charset=\"utf-8\""
 297       ();
 298     let text = read_file (rt_path () ^ "/logout.html") in
 299     cgi#out_channel#output_string text
 300   with
 301   | Not_found _ ->
 302     cgi # set_header
 303       ~status:`Internal_server_error
 304       ~cache:`No_cache
 305       ~content_type:"text/xml; charset=\"utf-8\""
 306       ());
 307   cgi#out_channel#commit_work()
 308 ;;
 309
 310 (* returns the length of the executed text and an html representation of the
 311  * current metasenv*)
 312 let advance (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
 313   let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
 314   let env = cgi#environment in
 315   (try
 316     let sid = Uuidm.of_string (Netcgi.Cookie.value (env#cookie "session")) in
 317     let sid = HExtlib.unopt sid in
 318     cgi # set_header
 319       ~cache:`No_cache
 320       ~content_type:"text/xml; charset=\"utf-8\""
 321       ();
 322     let text = cgi#argument_value "body" in
 323     prerr_endline ("body =\n" ^ text);
 324     let parsed_len, new_unparsed, new_status = advance0 sid text in
 325     let txt = output_status new_status in
 326     let body =
 327        "<response><parsed length=\"" ^ (string_of_int parsed_len) ^ "\" />" ^ txt
 328        ^ "</response>"
 329     in
 330     prerr_endline ("sending advance response:\n" ^ body);
 331     cgi#out_channel#output_string body
 332   with
 333   | Not_found _ ->
 334     cgi # set_header
 335       ~status:`Internal_server_error
 336       ~cache:`No_cache
 337       ~content_type:"text/xml; charset=\"utf-8\""
 338       ());
 339   cgi#out_channel#commit_work()
 340 ;;
 341
 342 let gotoBottom (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
 343   let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
 344   let env = cgi#environment in
 345   (try
 346     let sid = Uuidm.of_string (Netcgi.Cookie.value (env#cookie "session")) in
 347     let sid = HExtlib.unopt sid in
 348
 349     let rec aux parsed_len text =
 350       try
 351         prerr_endline ("evaluating: " ^ first_line text);
 352         let plen,new_unparsed,_new_status = advance0 sid text in
 353         aux (parsed_len+plen) new_unparsed
 354       with
 355       | _ -> parsed_len
 356     in
 357     cgi # set_header
 358       ~cache:`No_cache
 359       ~content_type:"text/xml; charset=\"utf-8\""
 360       ();
 361     let text = cgi#argument_value "body" in
 362     prerr_endline ("body =\n" ^ text);
 363     let parsed_len = aux 0 text in
 364     let status = MatitaAuthentication.get_status sid in
 365     let txt = output_status status in
 366     let body =
 367        "<response><parsed length=\"" ^ (string_of_int parsed_len) ^ "\" />" ^ txt
 368        ^ "</response>"
 369     in
 370     prerr_endline ("sending goto bottom response:\n" ^ body);
 371     cgi#out_channel#output_string body
 372    with Not_found -> cgi#set_header ~status:`Internal_server_error
 373       ~cache:`No_cache
 374       ~content_type:"text/xml; charset=\"utf-8\"" ());
 375   cgi#out_channel#commit_work()
 376 ;;
 377
 378 let retract (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
 379   let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
 380   let env = cgi#environment in
 381   (try
 382     let sid = Uuidm.of_string (Netcgi.Cookie.value (env#cookie "session")) in
 383     let sid = HExtlib.unopt sid in
 384     cgi # set_header
 385       ~cache:`No_cache
 386       ~content_type:"text/xml; charset=\"utf-8\""
 387       ();
 388     let history = MatitaAuthentication.get_history sid in
 389     let new_history,new_status =
 390        match history with
 391          _::(status::_ as history) ->
 392           history, status
 393       | [_] -> (prerr_endline "singleton";failwith "retract")
 394       | _ -> (prerr_endline "nil"; assert false) in
 395     NCicLibrary.time_travel new_status;
 396     MatitaAuthentication.set_history sid new_history;
 397     MatitaAuthentication.set_status sid new_status;
 398     prerr_endline ("after retract history.length = " ^
 399       string_of_int (List.length new_history));
 400     let body = output_status new_status in
 401     cgi#out_channel#output_string body
 402    with _ -> cgi#set_header ~status:`Internal_server_error
 403       ~cache:`No_cache
 404       ~content_type:"text/xml; charset=\"utf-8\"" ());
 405   cgi#out_channel#commit_work()
 406 ;;
 407
 408
 409 let viewLib (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
 410   let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
 411   let env = cgi#environment in
 412
 413     let sid = Uuidm.of_string (Netcgi.Cookie.value (env#cookie "session")) in
 414     let sid = HExtlib.unopt sid in
 415     cgi # set_header
 416       ~cache:`No_cache
 417       ~content_type:"text/html; charset=\"utf-8\""
 418       ();
 419     let uid = MatitaAuthentication.user_of_session sid in
 420
 421     let html = MatitaFilesystem.html_of_library uid in
 422     cgi#out_channel#output_string
 423       ((*
 424        "<html><head>\n" ^
 425        "<title>XML Tree Control</title>\n" ^
 426        "<link href=\"treeview/xmlTree.css\" type=\"text/css\" rel=\"stylesheet\">\n" ^
 427        "<script src=\"treeview/xmlTree.js\" type=\"text/javascript\"></script>\n" ^
 428        "<body>\n" ^ *)
 429        html (* ^ "\n</body></html>" *) );
 430   cgi#out_channel#commit_work()
 431
 432 ;;
 433
 434 let resetLib (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
 435   let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
 436   MatitaAuthentication.reset ();
 437     cgi # set_header
 438       ~cache:`No_cache
 439       ~content_type:"text/html; charset=\"utf-8\""
 440       ();
 441
 442     cgi#out_channel#output_string
 443       ("<html><head>\n" ^
 444        "<title>Matitaweb Reset</title>\n" ^
 445        "<body><H1>Reset completed</H1></body></html>");
 446     cgi#out_channel#commit_work()
 447
 448 open Netcgi1_compat.Netcgi_types;;
 449
 450 (**********************************************************************)
 451 (* Create the webserver                                               *)
 452 (**********************************************************************)
 453
 454
 455 let start() =
 456   let (opt_list, cmdline_cfg) = Netplex_main.args() in
 457
 458   let use_mt = ref true in
 459
 460   let opt_list' =
 461     [ "-mt", Arg.Set use_mt,
 462       "  Use multi-threading instead of multi-processing"
 463     ] @ opt_list in
 464
 465   Arg.parse
 466     opt_list'
 467     (fun s -> raise (Arg.Bad ("Don't know what to do with: " ^ s)))
 468     "usage: netplex [options]";
 469   let parallelizer =
 470     if !use_mt then
 471       Netplex_mt.mt()     (* multi-threading *)
 472     else
 473       Netplex_mp.mp() in  (* multi-processing *)
 474 (*
 475   let adder =
 476     { Nethttpd_services.dyn_handler = (fun _ -> process1);
 477       dyn_activation = Nethttpd_services.std_activation `Std_activation_buffered;
 478       dyn_uri = None;                 (* not needed *)
 479       dyn_translator = (fun _ -> ""); (* not needed *)
 480       dyn_accept_all_conditionals = false;
 481     } in
 482 *)
 483   let do_advance =
 484     { Nethttpd_services.dyn_handler = (fun _ -> advance);
 485       dyn_activation = Nethttpd_services.std_activation `Std_activation_buffered;
 486       dyn_uri = None;                 (* not needed *)
 487       dyn_translator = (fun _ -> ""); (* not needed *)
 488       dyn_accept_all_conditionals = false;
 489     } in
 490   let do_retract =
 491     { Nethttpd_services.dyn_handler = (fun _ -> retract);
 492       dyn_activation = Nethttpd_services.std_activation `Std_activation_buffered;
 493       dyn_uri = None;                 (* not needed *)
 494       dyn_translator = (fun _ -> ""); (* not needed *)
 495       dyn_accept_all_conditionals = false;
 496     } in
 497   let goto_bottom =
 498     { Nethttpd_services.dyn_handler = (fun _ -> gotoBottom);
 499       dyn_activation = Nethttpd_services.std_activation `Std_activation_buffered;
 500       dyn_uri = None;                 (* not needed *)
 501       dyn_translator = (fun _ -> ""); (* not needed *)
 502       dyn_accept_all_conditionals = false;
 503     } in
 504   let retrieve =
 505     { Nethttpd_services.dyn_handler = (fun _ -> retrieve);
 506       dyn_activation = Nethttpd_services.std_activation `Std_activation_buffered;
 507       dyn_uri = None;                 (* not needed *)
 508       dyn_translator = (fun _ -> ""); (* not needed *)
 509       dyn_accept_all_conditionals = false;
 510     } in
 511   let do_register =
 512     { Nethttpd_services.dyn_handler = (fun _ -> register);
 513       dyn_activation = Nethttpd_services.std_activation `Std_activation_buffered;
 514       dyn_uri = None;                 (* not needed *)
 515       dyn_translator = (fun _ -> ""); (* not needed *)
 516       dyn_accept_all_conditionals = false;
 517     } in
 518   let do_login =
 519     { Nethttpd_services.dyn_handler = (fun _ -> login);
 520       dyn_activation = Nethttpd_services.std_activation `Std_activation_buffered;
 521       dyn_uri = None;                 (* not needed *)
 522       dyn_translator = (fun _ -> ""); (* not needed *)
 523       dyn_accept_all_conditionals = false;
 524     } in
 525   let do_logout =
 526     { Nethttpd_services.dyn_handler = (fun _ -> logout);
 527       dyn_activation = Nethttpd_services.std_activation `Std_activation_buffered;
 528       dyn_uri = None;                 (* not needed *)
 529       dyn_translator = (fun _ -> ""); (* not needed *)
 530       dyn_accept_all_conditionals = false;
 531     } in
 532   let do_viewlib =
 533     { Nethttpd_services.dyn_handler = (fun _ -> viewLib);
 534       dyn_activation = Nethttpd_services.std_activation `Std_activation_buffered;
 535       dyn_uri = None;                 (* not needed *)
 536       dyn_translator = (fun _ -> ""); (* not needed *)
 537       dyn_accept_all_conditionals = false;
 538     } in
 539   let do_resetlib =
 540     { Nethttpd_services.dyn_handler = (fun _ -> resetLib);
 541       dyn_activation = Nethttpd_services.std_activation `Std_activation_buffered;
 542       dyn_uri = None;                 (* not needed *)
 543       dyn_translator = (fun _ -> ""); (* not needed *)
 544       dyn_accept_all_conditionals = false;
 545     } in
 546
 547   let nethttpd_factory =
 548     Nethttpd_plex.nethttpd_factory
 549       ~handlers:[ "advance", do_advance
 550                 ; "retract", do_retract
 551                 ; "bottom", goto_bottom
 552                 ; "open", retrieve
 553                 ; "register", do_register
 554                 ; "login", do_login
 555                 ; "logout", do_logout
 556                 ; "reset", do_resetlib
 557                 ; "viewlib", do_viewlib]
 558       () in
 559   MatitaInit.initialize_all ();
 560   MatitaAuthentication.deserialize ();
 561   Netplex_main.startup
 562     parallelizer
 563     Netplex_log.logger_factories   (* allow all built-in logging styles *)
 564     Netplex_workload.workload_manager_factories (* ... all ways of workload management *)
 565     [ nethttpd_factory ]           (* make this nethttpd available *)
 566     cmdline_cfg
 567 ;;
 568
 569 Sys.set_signal Sys.sigpipe Sys.Signal_ignore;
 570 start();;