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