+(* Copyright (C) 2004-2011, HELM Team.
+ *
+ * This file is part of HELM, an Hypertextual, Electronic
+ * Library of Mathematics, developed at the Computer Science
+ * Department, University of Bologna, Italy.
+ *
+ * HELM is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * HELM is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with HELM; if not, write to the Free Software
+ * Foundation, Inc., 59 Temple Place - Suite 330, Boston,
+ * MA 02111-1307, USA.
+ *
+ * For details, see the HELM World-Wide-Web page,
+ * http://helm.cs.unibo.it/
+ *)
+
+type session_id = Uuidm.t
+
+(* user table: user id, (password, optional session id) *)
+type user = string * (string * session_id option)
+
+let user_tbl = (ref [] : user list ref)
+
+(* session table: (user id, session id), matita status *)
+type session = (string * session_id) * MatitaEngine.status
+
+let session_tbl = (ref [] : session list ref)
+
+exception UsernameCollision of string
+
+let lookup_user uid = List.assoc uid !user_tbl
+
+let create_session uid status =
+ let pw,sid = List.assoc uid !user_tbl in
+ let clean_utbl = List.remove_assoc uid !user_tbl in
+ let new_session = Uuidm.create `V4 in
+ user_tbl := (uid,(pw,Some new_session))::clean_utbl;
+ let clean_stbl = match sid with
+ | Some sid' ->
+ List.remove_assoc (uid,sid') !session_tbl
+ | _ -> !session_tbl
+ in session_tbl := ((uid,new_session),status)::clean_stbl
+;;
+
+let logout_user uid =
+ match List.assoc uid !user_tbl with
+ | _,None -> ()
+ | pw, Some sid ->
+ user_tbl := (uid,(pw,None))::List.remove_assoc uid !user_tbl;
+ session_tbl := List.remove_assoc (uid,sid) !session_tbl
+;;
+
+let remove_user uid =
+ user_tbl := List.remove_assoc uid !user_tbl
+;;
+
+(* serialization and deserialization of the user table *)
+let config_path () =
+ let path = Helm_registry.get "matita.basedir" in
+ let dirname = Filename.dirname path in
+ HExtlib.mkdir dirname;
+ path
+;;
+
+let serialize () =
+ let clean_utbl = List.map (fun (uid,(pw,_)) -> uid,(pw,None)) !user_tbl in
+ let utbl_ch = open_out (config_path () ^ "/usertable.dump") in
+ Marshal.to_channel utbl_ch clean_utbl [];
+ close_out utbl_ch;
+;;
+
+let deserialize () =
+ let utbl_ch = open_in (config_path () ^ "/usertable.dump") in
+ user_tbl := Marshal.from_channel utbl_ch;
+ close_in utbl_ch;
+ (* old_sessions are now invalid *)
+ session_tbl := [];
+;;
+
+let add_user uid pw =
+ try
+ let _ = lookup_user uid in
+ raise (UsernameCollision uid)
+ with Not_found ->
+ user_tbl := (uid,(pw,None))::!user_tbl;
+ serialize ()
+;;