Profile Manager Control Panel

From: Luca Padovani Date: Tue, 21 Oct 2003 08:28:42 +0000 (+0000) Subject: * first version of the profile manager committed X-Git-Tag: V_0_2_2~47 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=c6b5e85cd64ca985f31685b6ffe7985fc7577bdb;p=helm.git * first version of the profile manager committed --- diff --git a/helm/DEVEL/profile-manager/Makefile b/helm/DEVEL/profile-manager/Makefile new file mode 100644 index 000000000..556644338 --- /dev/null +++ b/helm/DEVEL/profile-manager/Makefile @@ -0,0 +1,36 @@ +BIN_DIR = /usr/local/bin +REQUIRES = http +PREDICATES = +OCAMLOPTIONS = -package "$(REQUIRES)" -predicates "$(PREDICATES)" -pp camlp4o +OCAMLFIND = ocamlfind +OCAMLC = $(OCAMLFIND) ocamlc -thread $(OCAMLOPTIONS) +OCAMLOPT = $(OCAMLFIND) ocamlopt -thread $(OCAMLOPTIONS) +OCAMLDEP = ocamldep -pp camlp4o + +LIBRARIES = $(shell $(OCAMLFIND) query -recursive -predicates "byte $(PREDICATES)" -format "%d/%a" $(REQUIRES)) +LIBRARIES_OPT = $(shell $(OCAMLFIND) query -recursive -predicates "native $(PREDICATES)" -format "%d/%a" $(REQUIRES)) + +OBJS = response.cmo profile.cmo profile_manager_env.cmo profile_manager.cmo + +profile-manager: $(OBJS) $(LIBRARIES) + $(OCAMLC) -linkpkg -o $@ $(OBJS) + +profile-manager.opt: $(OBJS:.cmo=.cmx) $(LIBRARIES_OPT) + $(OCAMLOPT) -linkpkg -o $@ $(OBJS:.cmo=.cmx) + +.SUFFIXES: .ml .mli .cmo .cmi .cmx +.ml.cmo: + $(OCAMLC) -c $< +.mli.cmi: + $(OCAMLC) -c $< +.ml.cmx: + $(OCAMLOPT) -c $< + +$(OBJS): $(LIBRARIES) +$(OBJS:.cmo=.cmx)): $(LIBRARIES_OPT) + +clean: + rm -f *.cm[iox] *.o rdfly rdfly.opt + +.PHONY: install uninstall clean + diff --git a/helm/DEVEL/profile-manager/control.html b/helm/DEVEL/profile-manager/control.html new file mode 100644 index 000000000..2feb02fe9 --- /dev/null +++ b/helm/DEVEL/profile-manager/control.html @@ -0,0 +1,240 @@ + + + +Profile Manager Control Panel + + + + + + + + + + + +

Profile Manager Control Panel

+This is a control panel for the profile manager. You can control a +local or remote profile manager by filling the appropriate field below +and sending the desired commands. Any command issued to the profile +manager results into an XML response. Note that in order to use this +page you must have JavaScript enabled. If you have troubles, +please send an email to the author: lpadovan at cs dot unibo dot it. +

+

+WARNING: the information stored in a profile, +including the password, IS NOT encrypted in the profile nor while it +is travelling from your computer to the profile manager. DO NOT USE +THE PROFILE MANAGER FOR STORING SENSIBLE INFORMATION LIKE PASSWORDS +FOR SECURE ACCOUNTS OR ANY OTHER PERSONAL DATA.

+
+ + + + + + + + + + + + + + + + + + + + + + + +

+ + + + + diff --git a/helm/DEVEL/profile-manager/index.html b/helm/DEVEL/profile-manager/index.html new file mode 100644 index 000000000..caeebcf24 --- /dev/null +++ b/helm/DEVEL/profile-manager/index.html @@ -0,0 +1,8 @@ + + + + + + + + diff --git a/helm/DEVEL/profile-manager/profile-manager.xsl b/helm/DEVEL/profile-manager/profile-manager.xsl new file mode 100644 index 000000000..e32d58739 --- /dev/null +++ b/helm/DEVEL/profile-manager/profile-manager.xsl @@ -0,0 +1,55 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + \ No newline at end of file diff --git a/helm/DEVEL/profile-manager/profile.ml b/helm/DEVEL/profile-manager/profile.ml new file mode 100644 index 000000000..9c19b3c9d --- /dev/null +++ b/helm/DEVEL/profile-manager/profile.ml @@ -0,0 +1,119 @@ + +exception Permission_denied +exception Invalid_access of string + +type access_t = + Allowed + | Denied + | Password + +let access_of_string old = + function + None -> old + | Some "allowed" -> Allowed + | Some "denied" -> Denied + | Some "password" -> Password + | Some s -> raise (Invalid_access s) + +let string_of_access = + function + Allowed -> "allowed" + | Denied -> "denied" + | Password -> "password" + +type t = + { id : string; + mutable password : string; + mutable read_access : access_t; + mutable write_access : access_t; + mutable profile_access : access_t; + data : (string, string) Hashtbl.t; + } + +let serialize profile with_data = + let serialize_data data = + let sl = ref [] in + Hashtbl.iter + (fun field value -> + sl := (" " ^ (Response.quote value) ^ "\n")::!sl) + data ; + List.fold_left (^) "" !sl + in + "\n" ^ (if with_data then serialize_data profile.data else "") ^ "" + +let create key pwd = + let access, pwd' = + match pwd with + Some s -> Password, s + | None -> Allowed, "" + in + let profile = + { id = key; + password = pwd'; + read_access = access; + write_access = access; + profile_access = access; + data = Hashtbl.create 11 + } + in + profile + +let test_read_access profile pwd = + match pwd, profile.read_access with + Some s, Password when s = profile.password -> () + | None, Password when profile.password = "" -> () + | _, Allowed -> () + | _ -> raise Permission_denied + +let test_write_access profile pwd = + match pwd, profile.write_access with + Some s, Password when s = profile.password -> () + | None, Password when profile.password = "" -> () + | _, Allowed -> () + | _ -> raise Permission_denied + +let test_profile_access profile pwd = + match pwd, profile.profile_access with + Some s, Password when s = profile.password -> () + | None, Password when profile.password = "" -> () + | _, Allowed -> () + | _ -> raise Permission_denied + +let get profile pwd = + test_read_access profile pwd ; + serialize profile true + +let set profile field value pwd = + test_write_access profile pwd ; + begin + match value with + Some value' -> Hashtbl.replace profile.data field value' + | None -> Hashtbl.remove profile.data field + end ; + Response.ok () + +let del profile pwd = + test_profile_access profile pwd ; + Response.ok () + +let set_password profile new_pwd pwd = + test_profile_access profile pwd ; + let new_pwd' = + match new_pwd with + Some s -> s + | None -> "" + in + prerr_endline ("old " ^ profile.password ^ " new " ^ new_pwd') ; + profile.password <- new_pwd' ; + Response.ok () + +let set_access profile read_access write_access profile_access pwd = + test_profile_access profile pwd ; + profile.read_access <- access_of_string profile.read_access read_access ; + profile.write_access <- access_of_string profile.write_access write_access ; + profile.profile_access <- access_of_string profile.profile_access profile_access ; + Response.ok () diff --git a/helm/DEVEL/profile-manager/profile_manager.ml b/helm/DEVEL/profile-manager/profile_manager.ml new file mode 100644 index 000000000..1c61e6a3f --- /dev/null +++ b/helm/DEVEL/profile-manager/profile_manager.ml @@ -0,0 +1,177 @@ +(* + * Copyright (C) 2003: + * 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/ + *) + +exception Impossible + +let (profile_db : (string, Profile.t) Hashtbl.t) = + try + let ch = open_in Profile_manager_env.profile_db_path in + input_value ch + with + _ -> Hashtbl.create 211 + +let get_param_opt (req : Http_types.request) p = + try + match req#param p with + "" -> None + | s -> Some s + with + Http_types.Param_not_found _ -> None + +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 new_unique_key = + let rec aux () = + let key = new_key () in + if Hashtbl.mem profile_db key then + aux () + else + key + in + aux + +let list_profiles () = + let pl = ref [] in + Hashtbl.iter + (fun _ profile -> pl := (Profile.serialize profile false) :: !pl) + profile_db ; + "" ^ (List.fold_left (^) "" !pl) ^ "" + +let get_profile id pwd = + let profile = Hashtbl.find profile_db id in + Profile.get profile pwd + +let new_profile id pwd = + match id with + Some id' when Hashtbl.mem profile_db id' -> get_profile id' pwd + | Some id' -> + let profile = Profile.create id' pwd in + Hashtbl.add profile_db profile.Profile.id profile ; + Profile.serialize profile true + | None -> + let profile = Profile.create (new_unique_key ()) None in + Hashtbl.add profile_db profile.Profile.id profile ; + Profile.serialize profile true + +let set_profile id field value pwd = + let profile = Hashtbl.find profile_db id in + Profile.set profile field value pwd + +let del_profile id pwd = + let profile = Hashtbl.find profile_db id in + let res = Profile.del profile pwd in + Hashtbl.remove profile_db id ; + res + +let set_password id new_pwd pwd = + let profile = Hashtbl.find profile_db id in + Profile.set_password profile new_pwd pwd + +let set_access id read_access write_access profile_access pwd = + let profile = Hashtbl.find profile_db id in + Profile.set_access profile read_access write_access profile_access pwd + +let callback (req : Http_types.request) outchan = + let res = + try + prerr_endline ("Connection from " ^ req#clientAddr) ; + prerr_endline ("Received request: " ^ req#path) ; + begin + match req#path with + "/list" -> list_profiles () + | "/get" -> + let id = req#param "id" + and pwd = get_param_opt req "password" in + get_profile id pwd + | "/set" -> + let id = req#param "id" + and field = req#param "field" + and value = get_param_opt req "value" + and pwd = get_param_opt req "password" in + set_profile id field value pwd + | "/del" -> + let id = req#param "id" + and pwd = get_param_opt req "password" in + del_profile id pwd + | "/new" -> + let id = get_param_opt req "id" + and pwd = get_param_opt req "password" in + new_profile id pwd + | "/password" -> + let id = req#param "id" + and old_pwd = get_param_opt req "old_password" + and new_pwd = get_param_opt req "new_password" in + set_password id new_pwd old_pwd + | "/access" -> + let id = req#param "id" + and pwd = get_param_opt req "password" + and read_access = get_param_opt req "read" + and write_access = get_param_opt req "write" + and profile_access = get_param_opt req "profile" in + set_access id read_access write_access profile_access pwd + | s -> Response.error ("unrecognized command: " ^ s) + end + with + Not_found -> Response.error "unknown profile" + | Profile.Permission_denied -> Response.error "permission denied" + | e -> Response.error ("uncaught exception: " ^ (Printexc.to_string e)) + in + Http_daemon.respond + ~body:res ~headers:["Content-Type", "text/xml"] outchan + + (* daemon initialization *) + +let save_db () = + let ch = open_out Profile_manager_env.profile_db_path in + output_value ch profile_db ; + close_out ch + +let main () = + at_exit save_db ; + Sys.catch_break true ; + try + Http_daemon.start' ~timeout:(Some 600) ~port:58099 ~mode:`Thread callback + with + Sys.Break -> () +in +main () + diff --git a/helm/DEVEL/profile-manager/profile_manager_env.ml b/helm/DEVEL/profile-manager/profile_manager_env.ml new file mode 100644 index 000000000..cac43bd4e --- /dev/null +++ b/helm/DEVEL/profile-manager/profile_manager_env.ml @@ -0,0 +1,6 @@ + +let profile_db_path = + try + Sys.getenv "PROFILE_MANAGER_DB_PATH" + with + Not_found -> "/tmp/profile.db" diff --git a/helm/DEVEL/profile-manager/response.ml b/helm/DEVEL/profile-manager/response.ml new file mode 100644 index 000000000..e47a66651 --- /dev/null +++ b/helm/DEVEL/profile-manager/response.ml @@ -0,0 +1,8 @@ + +let quote_attribute s = s + +let quote s = s + +let error s = "" ^ (quote s) ^ "" + +let ok () = "" diff --git a/helm/DEVEL/profile-manager/welcome.html b/helm/DEVEL/profile-manager/welcome.html new file mode 100644 index 000000000..f6fbed438 --- /dev/null +++ b/helm/DEVEL/profile-manager/welcome.html @@ -0,0 +1,6 @@ + + + + + +