--- /dev/null
+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
+
--- /dev/null
+<html>
+
+<head>
+<title>Profile Manager Control Panel</title>
+
+<style type="text/css">
+#normal { background-color: white; font-family: sans-serif }
+td.head { font-weight: bold; background-color: #e6e6fa; color: brown }
+td.back { background-color: #e6e6fa; color: brown }
+#indent { margin-left: 1cm; margin-right: 1cm }
+</style>
+
+<script language="JavaScript">
+<!--
+function getParam(name, def)
+{
+ var search = top.location.search;
+ search = search.slice(1);
+ var args = search.split("&");
+ var value = "-1";
+ for (var i = 0 ; i < args.length ; i++) {
+ var couple = args[i].split("=");
+ if (couple[0] == name) value = couple[1];
+ }
+ if (value == "-1") value = def;
+ return value;
+}
+
+function getInitialURL()
+{
+ return getParam("pmURL", "http://mowgli.cs.unibo.it:58099/");
+}
+
+function getURL()
+{
+ return document.pmURL.elements[0].value;
+}
+
+function setURL(ss)
+{
+ if (ss.selectedIndex == 0) {
+ document.pmURL.elements[0].value = "";
+ } else {
+ document.pmURL.elements[0].value = "http://" + ss.options[ss.selectedIndex].value;
+ }
+}
+
+function escapePassword(pwd)
+{
+ if (ss == "") {
+ return "";
+ } else {
+ return ("&password=" + escape(pwd));
+ }
+}
+
+function getAccess(ss)
+{
+ return (ss.options[ss.selectedIndex].value);
+}
+-->
+</script>
+
+</head>
+
+<body>
+<a name="top"/>
+<table border="0" width="100%" cellpadding="4">
+<tr><td class="head" align="center"><big><big>Profile Manager Control Panel</big></big></td></tr>
+</table>
+
+<br />
+
+<div>
+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 <i>you must have JavaScript enabled</i>. If you have troubles,
+please send an email to the author: lpadovan at cs dot unibo dot it.
+</div>
+
+<p>
+<div style="color: red">
+<b>WARNING</b>: 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. </div>
+</p>
+
+<div>
+<br />
+
+<table border="1">
+ <tr> <td>
+ <form name="pmURL">
+ Profile Manager <b>URL</b>
+ <input type="text" value="http://localhost:58099/" size="50"/>
+ <select onChange="setURL(this)">
+ <option value="">---</option>
+ <option value="localhost:58099/">localhost</option>
+ <option value="mowgli.cs.unibo.it:58099/">mowgli</option>
+ </select>
+ </form>
+ </td> </tr>
+ <tr> <td>
+ <form>
+ <b>List</b> the profiles currently stored in the Profile Manager<br />
+ <input type="button" value="List"
+ onClick="top.result.location.replace(getURL() + 'list')"/>
+ </form>
+ </td>
+ </tr>
+ <tr>
+ <td>
+ <form name="newProfile">
+ <b>Create</b> a new profile<br />
+ <table>
+ <tr><td>Profile ID:</td><td> <input type="text" name="id" value="" /> (leave blank if you want an ID to be assigned automatically)</td></tr>
+ <tr><td>Password:</td><td><input type="text" name="password" value="" /> (optional)</td></tr>
+ </table>
+ <input type="button" value="Create"
+ onClick="top.result.location.replace(getURL() +
+ 'new?id=' + escape(document.newProfile.elements[0].value))"/>
+ </form>
+ </td>
+ </tr>
+ <tr>
+ <td>
+ <form name="delProfile">
+ <b>Delete</b> an existing profile<br />
+ <table>
+ <tr><td>Profile ID:</td><td> <input type="text" name="id" value="" /></td></tr>
+ <tr><td>Password:</td><td><input type="text" name="password" value="" /> (optional)</td></tr>
+ </table>
+ <input type="button" value="Delete"
+ onClick="top.result.location.replace(getURL() +
+ 'del?id=' + escape(document.delProfile.elements[0].value) +
+ '&password=' + escape(document.delProfile.elements[1].value))"/>
+ </form>
+ </td>
+ </tr>
+ <tr>
+ <td>
+ <form name="getProfile">
+ <b>Retrieve</b> an existing profile<br />
+ <table>
+ <tr><td>Profile ID:</td><td> <input type="text" name="id" value="" /></td></tr>
+ <tr><td>Password:</td><td><input type="text" name="password" value="" /> (optional)</td></tr>
+ </table>
+ <input type="button" value="Get"
+ onClick="top.result.location.replace(getURL() +
+ 'get?id=' + escape(document.getProfile.elements[0].value) +
+ '&password=' + escape(document.getProfile.elements[1].value))"/>
+ </form>
+ </td>
+ </tr>
+ <tr>
+ <td>
+ <form name="setProfile">
+ <b>Set</b> the value for a field in an existing profile<br />
+ <table>
+ <tr><td>Profile ID:</td><td> <input type="text" name="id" value="" /></td></tr>
+ <tr><td>Password:</td><td><input type="text" name="password" value="" /> (optional)</td></tr>
+ <tr><td>Field:</td><td><input type="text" name="field" value="" /></td></tr>
+ <tr><td>Value:</td><td><input type="text" name="value" value="" /> (optional, if blank will remove the field from the profile)</td></tr>
+ </table>
+ <input type="button" value="Set"
+ onClick="top.result.location.replace(getURL() +
+ 'set?id=' + escape(document.setProfile.elements[0].value) +
+ '&password=' + escape(document.setProfile.elements[1].value) +
+ '&field=' + escape(document.setProfile.elements[2].value) +
+ '&value=' + escape(document.setProfile.elements[3].value))"/>
+ </form>
+ </td>
+ </tr>
+ <tr>
+ <td>
+ <form name="setPassword">
+ <b>Set/Change</b> the password for a profile<br />
+ <table>
+ <tr><td>Profile ID:</td><td> <input type="text" name="id" value="" /></td></tr>
+ <tr><td>Old password:</td><td><input type="text" name="old_password" value="" /> (optional)</td></tr>
+ <tr><td>New password:</td><td><input type="text" name="new_password" value="" /> (optional)</td></tr>
+ </table>
+ <input type="button" value="Set/Change"
+ onClick="top.result.location.replace(getURL() +
+ 'password?id=' + escape(document.setPassword.elements[0].value) +
+ '&old_password=' + escape(document.setPassword.elements[1].value) +
+ '&new_password=' + escape(document.setPassword.elements[2].value))"/>
+ </form>
+ </td>
+ </tr>
+ <tr>
+ <td>
+ <form name="setAccess">
+ <b>Set</b> the access capabilities for a profile<br />
+ <table>
+ <tr><td>Profile ID:</td><td> <input type="text" name="id" value="" /></td></tr>
+ <tr><td>Password:</td><td><input type="text" name="password" value="" /> (optional)</td></tr>
+ <tr><td>Read access:</td><td>
+ <select>
+ <option value="allowed">allowed</option>
+ <option value="denied">denied</option>
+ <option value="password">allowed with password</option>
+ </select>
+ </td></tr>
+ <tr><td>Write access:</td><td>
+ <select>
+ <option value="allowed">allowed</option>
+ <option value="denied">denied</option>
+ <option value="password">allowed with password</option>
+ </select>
+ </td></tr>
+ <tr><td>Profile access:</td><td>
+ <select>
+ <option value="allowed">allowed</option>
+ <option value="denied">denied</option>
+ <option value="password">allowed with password</option>
+ </select>
+ </td></tr>
+ </table>
+ <input type="button" value="Set"
+ onClick="top.result.location.replace(getURL() +
+ 'access?id=' + escape(document.setAccess.elements[0].value) +
+ '&password=' + escape(document.setAccess.elements[1].value) +
+ '&read=' + getAccess(document.setAccess.elements[2]) +
+ '&write=' + getAccess(document.setAccess.elements[3]) +
+ '&profile=' + getAccess(document.setAccess.elements[4]))"/>
+ </form>
+ </td>
+ </tr>
+</table>
+</div>
+
+</body>
+
+</html>
+
--- /dev/null
+<html>
+
+<frameset rows="75%,*">
+ <frame src="control.html" name="control"/>
+ <frame src="welcome.html" name="result"/>
+</frameset>
+
+</html>
--- /dev/null
+<xsl:stylesheet version="1.0" xmlns:xsl="http://www.w3.org/1999/XSL/Transform">
+
+ <xsl:template name="profile_manager_list">
+ <xsl:param name="managerURL" select="''"/>
+ <xsl:copy-of select="document(string-concat($managerURL, 'list'))"/>
+ </xsl:template>
+
+ <xsl:template name="profile_manager_new">
+ <xsl:param name="managerURL" select="''"/>
+ <xsl:param name="id" select="''"/> <!-- optional -->
+ <xsl:param name="password" select="''"/> <!-- optional -->
+ <xsl:copy-of select="document(concat($managerURL, 'new?id=', $id, '&password=', $password))"/>
+ </xsl:template>
+
+ <xsl:template name="profile_manager_delete">
+ <xsl:param name="managerURL" select="''"/>
+ <xsl:param name="id" select="''"/>
+ <xsl:param name="password" select="''"/> <!-- optional -->
+ <xsl:copy-of select="document(concat($managerURL, 'del?id=', $id, '&password=', $password))"/>
+ </xsl:template>
+
+ <xsl:template name="profile_manager_get">
+ <xsl:param name="managerURL" select="''"/>
+ <xsl:param name="id" select="''"/>
+ <xsl:param name="password" select="''"/> <!-- optional -->
+ <xsl:copy-of select="document(concat($managerURL, 'get?id=', $id, '&password=', $password))"/>
+ </xsl:template>
+
+ <xsl:template name="profile_manager_set">
+ <xsl:param name="managerURL" select="''"/>
+ <xsl:param name="id" select="''"/>
+ <xsl:param name="field" select="''"/>
+ <xsl:param name="value" select="''"/> <!-- optional -->
+ <xsl:param name="password" select="''"/> <!-- optional -->
+ <xsl:copy-of select="document(concat($managerURL, 'set?id=', $id, '&field=', $field, '&value=', $value, '&password=', $password))"/>
+ </xsl:template>
+
+ <xsl:template name="profile_manager_set_password">
+ <xsl:param name="managerURL" select="''"/>
+ <xsl:param name="id" select="''"/>
+ <xsl:param name="old_password" select="''"/> <!-- optional -->
+ <xsl:param name="new_password" select="''"/> <!-- optional -->
+ <xsl:copy-of select="document(concat($managerURL, 'get?id=', $id, '&old_password=', $old_password, '&new_password=', $new_password))"/>
+ </xsl:template>
+
+ <xsl:template name="profile_manager_set_access">
+ <xsl:param name="managerURL" select="''"/>
+ <xsl:param name="id" select="''"/>
+ <xsl:param name="read" select="''"/> <!-- optional -->
+ <xsl:param name="write" select="''"/> <!-- optional -->
+ <xsl:param name="profile" select="''"/> <!-- optional -->
+ <xsl:copy-of select="document(concat($managerURL, 'get?id=', $id, '&read=', $read, '&write=', $write, '&profile=', $profile))"/>
+ </xsl:template>
+
+</xsl:stylesheet>
\ No newline at end of file
--- /dev/null
+
+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 := (" <field id=\"" ^ (Response.quote_attribute field) ^ "\">" ^ (Response.quote value) ^ "</field>\n")::!sl)
+ data ;
+ List.fold_left (^) "" !sl
+ in
+ "<profile id=\"" ^ profile.id ^
+ "\" read=\"" ^ (string_of_access profile.read_access) ^
+ "\" write=\"" ^ (string_of_access profile.write_access) ^
+ "\" profile=\"" ^ (string_of_access profile.profile_access) ^
+ "\">\n" ^ (if with_data then serialize_data profile.data else "") ^ "</profile>"
+
+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 ()
--- /dev/null
+(*
+ * Copyright (C) 2003:
+ * 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/
+ *)
+
+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 ;
+ "<profiles>" ^ (List.fold_left (^) "" !pl) ^ "</profiles>"
+
+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 ()
+
--- /dev/null
+
+let profile_db_path =
+ try
+ Sys.getenv "PROFILE_MANAGER_DB_PATH"
+ with
+ Not_found -> "/tmp/profile.db"
--- /dev/null
+
+let quote_attribute s = s
+
+let quote s = s
+
+let error s = "<error>" ^ (quote s) ^ "</error>"
+
+let ok () = "<ok/>"
--- /dev/null
+<html>
+
+<body bgcolor="white">
+</body>
+
+</html>
projects / helm.git / commitdiff