+ | HExtlib.Localized (_,e) -> raise e
+ (*| End_of_file -> raise Margin *)
+ in
+ let stringbuf = Ulexing.from_utf8_string new_statements in
+ let interpr = GrafiteDisambiguate.get_interpr st#disambiguate_db in
+ let outstr = ref "" in
+ ignore (SmallLexer.mk_small_printer interpr outstr stringbuf);
+ prerr_endline ("parser output: " ^ !outstr);
+ MatitaAuthentication.set_status sid st;
+ MatitaAuthentication.set_history sid (st::history);
+ parsed_len,
+ Netencoding.Html.encode ~in_enc:`Enc_utf8 ~prefer_name:false
+ () (html_of_matita !outstr), new_unparsed, st
+
+let register (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+ let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
+ let env = cgi#environment in
+
+ assert (cgi#arguments <> []);
+ let uid = cgi#argument_value "userid" in
+ let userpw = cgi#argument_value "password" in
+ (try
+ MatitaAuthentication.add_user uid userpw;
+ env#set_output_header_field "Location" "/index.html"
+ with
+ | MatitaAuthentication.UsernameCollision _ ->
+ cgi#set_header
+ ~cache:`No_cache
+ ~content_type:"text/html; charset=\"utf-8\""
+ ();
+ cgi#out_channel#output_string
+ "<html><head></head><body>Error: User id collision!</body></html>"
+ | MatitaFilesystem.SvnError msg ->
+ cgi#set_header
+ ~cache:`No_cache
+ ~content_type:"text/html; charset=\"utf-8\""
+ ();
+ cgi#out_channel#output_string
+ ("<html><head></head><body><p>Error: Svn checkout failed!<p><p><textarea>"
+ ^ msg ^ "</textarea></p></body></html>"));
+ cgi#out_channel#commit_work()
+;;
+
+let login (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+ let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
+ let env = cgi#environment in
+
+ assert (cgi#arguments <> []);
+ let uid = cgi#argument_value "userid" in
+ let userpw = cgi#argument_value "password" in
+ let pw,_ = MatitaAuthentication.lookup_user uid in
+
+ if pw = userpw then
+ begin
+ let _ = MatitaFilesystem.html_of_library uid in
+ let sid = MatitaAuthentication.create_session uid in
+ (* let cookie = Netcgi.Cookie.make "session" (Uuidm.to_string sid) in
+ cgi#set_header ~set_cookies:[cookie] (); *)
+ env#set_output_header_field
+ "Set-Cookie" ("session=" ^ (Uuidm.to_string sid));
+ env#set_output_header_field "Location" "/index.html"
+ end
+ else
+ begin
+ prerr_endline ("ERROR: received " ^ userpw ^ "but the password is " ^ pw);
+ cgi#set_header
+ ~cache:`No_cache
+ ~content_type:"text/html; charset=\"utf-8\""
+ ();
+ cgi#out_channel#output_string
+ "<html><head></head><body>Authentication error</body></html>"
+ end;
+
+ cgi#out_channel#commit_work()
+
+;;
+
+let logout (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+ let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
+ let env = cgi#environment in
+ (try
+ let sid = Uuidm.of_string (Netcgi.Cookie.value (env#cookie "session")) in
+ let sid = HExtlib.unopt sid in
+ MatitaAuthentication.logout_user sid;
+ cgi # set_header
+ ~cache:`No_cache
+ ~content_type:"text/html; charset=\"utf-8\""
+ ();
+ let text = read_file (rt_path () ^ "/logout.html") in
+ cgi#out_channel#output_string text
+ with
+ | Not_found _ ->
+ cgi # set_header
+ ~status:`Internal_server_error
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ());
+ cgi#out_channel#commit_work()
+;;
+
+(* returns the length of the executed text and an html representation of the
+ * current metasenv*)
+let advance (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+ let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
+ let env = cgi#environment in
+ (try
+ let sid = Uuidm.of_string (Netcgi.Cookie.value (env#cookie "session")) in
+ let sid = HExtlib.unopt sid in
+ cgi # set_header
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ();
+ let text = cgi#argument_value "body" in
+ prerr_endline ("body =\n" ^ text);
+ let parsed_len, new_parsed, new_unparsed, new_status = advance0 sid text in
+ let txt = output_status new_status in
+ let body =
+ "<response><parsed length=\"" ^ (string_of_int parsed_len) ^ "\">" ^
+ new_parsed ^ "</parsed>" ^ txt
+ ^ "</response>"
+ in
+ prerr_endline ("sending advance response:\n" ^ body);
+ cgi#out_channel#output_string body
+ with
+ | Not_found _ ->
+ cgi # set_header
+ ~status:`Internal_server_error
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ());
+ cgi#out_channel#commit_work()
+;;
+
+let gotoBottom (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+ let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
+ let env = cgi#environment in
+ (try
+ let sid = Uuidm.of_string (Netcgi.Cookie.value (env#cookie "session")) in
+ let sid = HExtlib.unopt sid in
+
+ let rec aux parsed_len parsed_txt text =
+ try
+ prerr_endline ("evaluating: " ^ first_line text);
+ let plen,new_parsed,new_unparsed,_new_status = advance0 sid text in
+ aux (parsed_len+plen) (parsed_txt ^ new_parsed) new_unparsed
+ with
+ | End_of_file ->
+ let status = MatitaAuthentication.get_status sid in
+ GrafiteTypes.Serializer.serialize
+ ~baseuri:(NUri.uri_of_string status#baseuri) status;
+ parsed_len, parsed_txt
+ | _ -> parsed_len, parsed_txt
+ in
+ cgi # set_header
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ();
+ let text = cgi#argument_value "body" in
+ prerr_endline ("body =\n" ^ text);
+ let parsed_len, new_parsed = aux 0 "" text in
+ let status = MatitaAuthentication.get_status sid in
+ let txt = output_status status in
+ let body =
+ "<response><parsed length=\"" ^ (string_of_int parsed_len) ^ "\">" ^
+ new_parsed ^ "</parsed>" ^ txt
+ ^ "</response>"
+ in
+ (*let body =
+ "<response><parsed length=\"" ^ (string_of_int parsed_len) ^ "\" />" ^ txt
+ ^ "</response>"
+ in*)
+ prerr_endline ("sending goto bottom response:\n" ^ body);
+ cgi#out_channel#output_string body
+ with Not_found -> cgi#set_header ~status:`Internal_server_error
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\"" ());
+ cgi#out_channel#commit_work()
+;;
+
+let retract (cgi : Netcgi1_compat.Netcgi_types.cgi_activation) =
+ let cgi = Netcgi1_compat.Netcgi_types.of_compat_activation cgi in
+ let env = cgi#environment in
+ (try
+ let sid = Uuidm.of_string (Netcgi.Cookie.value (env#cookie "session")) in
+ let sid = HExtlib.unopt sid in
+ cgi # set_header
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\""
+ ();
+ let history = MatitaAuthentication.get_history sid in
+ let new_history,new_status =
+ match history with
+ _::(status::_ as history) ->
+ history, status
+ | [_] -> (prerr_endline "singleton";failwith "retract")
+ | _ -> (prerr_endline "nil"; assert false) in
+ NCicLibrary.time_travel new_status;
+ MatitaAuthentication.set_history sid new_history;
+ MatitaAuthentication.set_status sid new_status;
+ prerr_endline ("after retract history.length = " ^
+ string_of_int (List.length new_history));
+ let body = output_status new_status in
+ cgi#out_channel#output_string body
+ with _ -> cgi#set_header ~status:`Internal_server_error
+ ~cache:`No_cache
+ ~content_type:"text/xml; charset=\"utf-8\"" ());
+ cgi#out_channel#commit_work()