From: Luca Padovani Date: Thu, 27 May 2004 15:04:33 +0000 (+0000) Subject: * it is now possible to set multiple parameters upon creation (or cloning) X-Git-Tag: pre_subst_in_kernel~68 X-Git-Url: http://matita.cs.unibo.it/gitweb/?a=commitdiff_plain;h=9b12c7574b3d0e0b8bf3a3a67efa03e36abf3f0d;p=helm.git * it is now possible to set multiple parameters upon creation (or cloning) of a new profile --- diff --git a/helm/uwobo/uwobo.ml b/helm/uwobo/uwobo.ml index abb3644f0..345ccda59 100644 --- a/helm/uwobo/uwobo.ml +++ b/helm/uwobo/uwobo.ml @@ -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 ("

" ^ s ^ "

") 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 -> "

" ^ k ^ " = " ^ v ^ "

") res) ^ "") 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 diff --git a/helm/uwobo/uwobo_profiles.ml b/helm/uwobo/uwobo_profiles.ml index c34ba3ed9..67f19879d 100644 --- a/helm/uwobo/uwobo_profiles.ml +++ b/helm/uwobo/uwobo_profiles.ml @@ -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))