* preliminary version of profile management

diff --git a/helm/uwobo/uwobo_profiles.ml b/helm/uwobo/uwobo_profiles.ml
new file mode 100644 (file)
index 0000000..715c247
--- /dev/null
+++ b/helm/uwobo/uwobo_profiles.ml
@@ -0,0 +1,150 @@
+(*
+ * Copyright (C) 2004:
+ *    Stefano Zacchiroli <zack@cs.unibo.it>
+ *    for the HELM Team http://helm.cs.unibo.it/
+ *
+ *  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 profile_id = string
+
+let profiles = "profiles"
+
+let profile_key pid =
+  profiles ^ "." ^ pid
+
+let string_of_permission =
+ function
+   `Read -> "read"
+  | `Write -> "write"
+  | `Admin -> "admin"
+
+let permission_key for_what pid =
+ profile_key pid ^ ".permissions." ^ (string_of_permission for_what)
+
+let read_permission_key = permission_key `Read
+let write_permission_key = permission_key `Write
+let admin_permission_key = permission_key `Admin
+
+let password_key pid =
+  profile_key pid ^ ".password"
+
+let params_key pid =
+  profile_key pid ^ ".params"
+
+let param_key pid param =
+  params_key pid ^ "." ^ param
+
+exception Access_denied of string * profile_id
+exception Profile_exists of profile_id
+exception Impossible
+
+let new_key () =
+  let hex_of_nibble n =
+    if n >= 0 && n < 10 then
+      string_of_int n
+    else if n >= 10 && n < 16 then
+      String.make 1 (Char.chr (n - 10 + (Char.code 'A')))
+    else
+      raise Impossible
+  in
+  let rec aux s =
+    function
+        0 -> s
+      | n -> aux ((hex_of_nibble (Random.int 16)) ^ s) (n - 1)
+  in
+  aux "" 4
+
+let create_fresh_id =
+  let rec aux () =
+    let key = new_key () in
+    if Helm_registry.has (read_permission_key key) then
+      aux ()
+    else
+      key
+  in
+  aux
+
+let list () = fst (Helm_registry.ls profiles)
+
+let to_list_rel ~prefix () =
+ List.map (fun (key,value) -> Pcre.replace ~pat:("^" ^ Pcre.quote (prefix ^ ".")) key, value)
+  (Helm_registry.to_list ~prefix ())
+
+let check_permission pid password for_what =
+  match password, Helm_registry.get_bool (permission_key for_what pid) with
+      None, true -> ()
+    | Some pwd, false when Some pwd = Helm_registry.get_opt Helm_registry.get (password_key pid) -> ()
+    | _ -> raise (Access_denied (string_of_permission for_what, pid))
+
+let create ?id ?clone ?clone_password ?(read_perm=true) ?(write_perm=true) ?(admin_perm=true) ?password () =
+  let pid =
+    match id with
+       None -> create_fresh_id ()
+      | Some pid when Helm_registry.has (read_permission_key pid) -> raise (Profile_exists pid)
+      | Some pid -> pid
+  in
+  let params = 
+    match clone with
+       None -> []
+      | Some pid ->
+         check_permission pid clone_password `Read ;
+         to_list_rel ~prefix:(params_key pid) ()
+  in
+    List.iter (fun (key, value) -> Helm_registry.set_string key value) params ;
+    Helm_registry.set_bool (read_permission_key pid) read_perm ;
+    Helm_registry.set_bool (write_permission_key pid) write_perm ;
+    Helm_registry.set_bool (admin_permission_key pid) admin_perm ;
+    Helm_registry.set_opt Helm_registry.set_string (password_key pid) password ;
+    pid
+
+let remove pid ?password () =
+  check_permission pid password `Admin ;
+  List.iter (fun (key, _) -> Helm_registry.unset key) (Helm_registry.to_list ~prefix:(profile_key pid) ())
+
+let get_params pid ?password () =
+   check_permission pid password `Read ;
+   to_list_rel ~prefix:(params_key pid) ()
+
+let set_param pid ?password ~key ~value () =
+  check_permission pid password `Write ;
+  match value with
+      Some value' -> Helm_registry.set (param_key pid key) value'
+    | None -> Helm_registry.unset (param_key pid key)
+
+let get_param pid ?password ~key () =
+  check_permission pid password `Read ;
+  Helm_registry.get (param_key pid key)
+
+let set_password pid ?old_password new_password =
+  check_permission pid old_password `Admin ;
+  Helm_registry.set_opt Helm_registry.set (password_key pid) new_password
+
+let set_permission pid ?password for_what value =
+  check_permission pid password `Admin ;
+  Helm_registry.set_bool (permission_key for_what pid) value
+
+let get_permission pid ?password for_what = 
+  check_permission pid password `Admin ;
+  Helm_registry.get_bool (permission_key for_what pid)
+

diff --git a/helm/uwobo/uwobo_profiles.mli b/helm/uwobo/uwobo_profiles.mli
new file mode 100644 (file)
index 0000000..fc0798f
--- /dev/null
+++ b/helm/uwobo/uwobo_profiles.mli
@@ -0,0 +1,56 @@
+(*
+ * Copyright (C) 2004:
+ *    Stefano Zacchiroli <zack@cs.unibo.it>
+ *    for the HELM Team http://helm.cs.unibo.it/
+ *
+ *  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 profile_id = string
+
+exception Access_denied of string * profile_id
+exception Profile_exists of profile_id
+
+val list : unit -> string list
+val create :
+  ?id:profile_id ->
+  ?clone:profile_id ->
+  ?clone_password:string ->
+  ?read_perm:bool ->
+  ?write_perm:bool ->
+  ?admin_perm:bool -> ?password:string -> unit -> profile_id
+val remove : profile_id -> ?password:string -> unit -> unit
+val get_params : profile_id -> ?password:string -> unit -> (string * string) list
+val set_param :
+  profile_id ->
+  ?password:string -> key:string -> value:(string option) -> unit -> unit
+val get_param :
+  profile_id -> ?password:string -> key:string -> unit -> string
+val set_password :
+  profile_id -> ?old_password:string -> string option -> unit
+val set_permission :
+  profile_id ->
+  ?password:string -> [ `Admin | `Read | `Write ] -> bool -> unit
+val get_permission :
+  profile_id -> ?password:string -> [ `Admin | `Read | `Write ] -> bool
+