]> matita.cs.unibo.it Git - helm.git/commitdiff
* it is now possible to set multiple parameters upon creation (or cloning)
authorLuca Padovani <luca.padovani@unito.it>
Thu, 27 May 2004 15:04:33 +0000 (15:04 +0000)
committerLuca Padovani <luca.padovani@unito.it>
Thu, 27 May 2004 15:04:33 +0000 (15:04 +0000)
  of a new profile

helm/uwobo/uwobo.ml
helm/uwobo/uwobo_profiles.ml

index abb3644f080c6a29c96d477d081bbbc9d91303ad..345ccda59c53ccb2f769a34a50a283d6852ea2c2 100644 (file)
@@ -142,7 +142,30 @@ let parse_apply_params =
     ((fun _ -> []), []) (* no parameters, no properties *)
 ;;
 
-  (** Parse libxslt's message modes for error and debugging messages. Default is
+let serialize_param_list =
+  let is_global_param = Pcre.pmatch ~pat:"^param(\\.[^.]+){1}$" in
+  let is_local_param = Pcre.pmatch ~pat:"^param(\\.[^.]+){2}$" in
+    function params ->
+      let param_value_list =
+       List.filter
+         (fun (param, _) -> (is_global_param param) || (is_local_param param))
+         params
+      in
+       (String.concat
+          "," 
+          (List.map
+             (fun (param, value) -> (Pcre.replace ~pat:"^param\\." param) ^ "=" ^ value)
+             param_value_list))
+         
+let deserialize_param_list =
+  List.map
+    (fun pv ->
+       match Pcre.split ~pat:"=" pv with
+          [key] -> (key, None)
+        | [key; value] -> (key, Some value)
+        | _ -> assert false)
+
+(** Parse libxslt's message modes for error and debugging messages. Default is
   to ignore mesages of both kind *)
 let parse_libxslt_msgs_mode (req: Http_types.request) =
   ((try
@@ -365,7 +388,8 @@ let callback
        let profile_list = Uwobo_profiles.list () in
        respond_html ("<html><body><ul>" ^ String.concat "" (List.map (fun s -> "<li>" ^ s ^ "</li>") profile_list) ^ "</ul></body></html>") outchan
     | "/createprofile" ->
-       let cmd = sprintf "createprofile %s,%s,%s,%s,%s,%s,%s" 
+       let serialized_param_value_list = serialize_param_list req#params in
+       let cmd = sprintf "createprofile %s,%s,%s,%s,%s,%s,%s,%s" 
                    (string_of_param_option req "id")
                    (string_of_param_option req "orig")
                    (string_of_param_option req "origpassword")
@@ -373,6 +397,7 @@ let callback
                    (string_of_param_option req "writeperm")
                    (string_of_param_option req "adminperm")
                    (string_of_param_option req "password")
+                   serialized_param_value_list
        in
          short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan
     | "/removeprofile" -> 
@@ -420,22 +445,11 @@ let callback
          String.concat "" (List.map (fun k,v -> "<li><key>" ^ k ^ "</key> = <value>" ^ v  ^ "</value></li>") res) ^
          "</ul></body></html>") outchan
     | "/setparams" ->
-       let is_global_param = Pcre.pmatch ~pat:"^param(\\.[^.]+){1}$" in
-       let is_local_param = Pcre.pmatch ~pat:"^param(\\.[^.]+){2}$" in
-       let param_value_list =
-         List.filter
-           (fun (param, _) -> (is_global_param param) || (is_local_param param))
-           req#params
-       in
-       let serialized_param_value_list =
-         List.map
-           (fun (param, value) -> (Pcre.replace ~pat:"^param\\." param) ^ "=" ^ value)
-           param_value_list
-       in
+       let serialized_param_value_list = serialize_param_list req#params in
        let cmd = sprintf "setparams %s,%s,%s"
                    (req#param "id")
                    (string_of_param_option req "password")
-                   (String.concat "," serialized_param_value_list)
+                   serialized_param_value_list
        in
          short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan
     | "/getparam" ->
@@ -653,12 +667,9 @@ let main () =
                 raise Restart_HTTP_daemon
            | line when Pcre.pmatch ~rex:createprofile_cmd_RE line -> (* /createprofile *)
               stop_http_daemon ();
-             let params =
-                List.map string_option_of_string (Pcre.split ~pat:"," (Pcre.replace ~rex:createprofile_cmd_RE line))
-              in
                begin
-                 match params with
-                     [id; clone; clone_password; read_perm; write_perm; admin_perm; password] ->
+                 match (Pcre.split ~pat:"," (Pcre.replace ~rex:createprofile_cmd_RE line)) with
+                     id::clone::clone_password::read_perm::write_perm::admin_perm::password::pv_list ->
                        let bool_option_of_string_option =
                          function
                              Some "true" -> Some true
@@ -667,15 +678,21 @@ let main () =
                        in
                        let pid =
                          Uwobo_profiles.create
-                           ?id
-                           ?clone
-                           ?clone_password 
-                           ?read_perm:(bool_option_of_string_option read_perm)
-                           ?write_perm:(bool_option_of_string_option write_perm)
-                           ?admin_perm:(bool_option_of_string_option admin_perm)
-                           ?password
+                           ?id:(string_option_of_string id)
+                           ?clone:(string_option_of_string clone)
+                           ?clone_password:(string_option_of_string clone_password)
+                           ?read_perm:(bool_option_of_string_option (string_option_of_string read_perm))
+                           ?write_perm:(bool_option_of_string_option (string_option_of_string write_perm))
+                           ?admin_perm:(bool_option_of_string_option (string_option_of_string admin_perm))
+                           ?password:(string_option_of_string password)
                            ()
                        in
+                       let pv_list' = (deserialize_param_list pv_list) in
+                         List.iter
+                           (fun (key, value) ->
+                              Uwobo_profiles.set_param
+                              pid ?password:(string_option_of_string password) ~key ~value ())
+                           pv_list' ;
                          save_configuration () ;
                          output_string res_pipe ("Profile " ^ pid ^ " created. Hi " ^ pid) ;
                          raise Restart_HTTP_daemon
@@ -697,14 +714,7 @@ let main () =
                let pid, password, pv_list =
                  match Pcre.split ~pat:"," (Pcre.replace ~rex:setparams_cmd_RE line) with
                      pid::password::pv_list ->
-                       pid, (string_option_of_string password),
-                       (List.map
-                          (fun pv ->
-                             match Pcre.split ~pat:"=" pv with
-                                 [key] -> (key, None)
-                               | [key; value] -> (key, Some value)
-                               | _ -> assert false)
-                          pv_list)
+                       pid, (string_option_of_string password), (deserialize_param_list pv_list)
                    | _ -> assert false
                in
                  List.iter
index c34ba3ed91ff434c435a28f029c9d3df6a492bbe..67f19879d8ff13058a3a188ee94f59eaf3af144e 100644 (file)
@@ -93,7 +93,7 @@ let to_list_rel ~prefix () =
 
 let check_permission pid password for_what =
   match password, Helm_registry.get_bool (permission_key for_what pid) with
-      None, true -> ()
+      _, 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))