From 15ef65f8ccfd539a6ee77d609325cf991bcce789 Mon Sep 17 00:00:00 2001 From: Luca Padovani Date: Sat, 22 May 2004 07:01:09 +0000 Subject: [PATCH] * preliminary version of profile management --- helm/uwobo/uwobo_profiles.ml | 150 ++++++++++++++++++++++++++++++++++ helm/uwobo/uwobo_profiles.mli | 56 +++++++++++++ 2 files changed, 206 insertions(+) create mode 100644 helm/uwobo/uwobo_profiles.ml create mode 100644 helm/uwobo/uwobo_profiles.mli diff --git a/helm/uwobo/uwobo_profiles.ml b/helm/uwobo/uwobo_profiles.ml new file mode 100644 index 000000000..715c24771 --- /dev/null +++ b/helm/uwobo/uwobo_profiles.ml @@ -0,0 +1,150 @@ +(* + * Copyright (C) 2004: + * Stefano Zacchiroli + * 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 index 000000000..fc0798f14 --- /dev/null +++ b/helm/uwobo/uwobo_profiles.mli @@ -0,0 +1,56 @@ +(* + * Copyright (C) 2004: + * Stefano Zacchiroli + * 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 + -- 2.39.2