((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 (add_cmd_RE, remove_cmd_RE, reload_cmd_RE, kill_cmd_RE,
createprofile_cmd_RE, removeprofile_cmd_RE, setprofileparam_cmd_RE,
- setpassword_cmd_RE, setpermission_cmd_RE) =
+ setparams_cmd_RE, setpassword_cmd_RE, setpermission_cmd_RE) =
(Pcre.regexp "^add ", Pcre.regexp "^remove ", Pcre.regexp "^reload ",
Pcre.regexp "^kill", Pcre.regexp "^createprofile ", Pcre.regexp "^removeprofile ",
- Pcre.regexp "^setprofileparam ", Pcre.regexp "^setpassword ", Pcre.regexp "^setpermission ")
+ Pcre.regexp "^setprofileparam ",
+ Pcre.regexp "^setparams ", Pcre.regexp "^setpassword ", Pcre.regexp "^setpermission ")
;;
(** raised by child processes when HTTP daemon process have to be restarted *)
(* Let's check that the port is free *)
(try
ignore
- (Http_client.http_get
+ (Http_user_agent.get
("http://127.0.0.1:" ^ string_of_int port ^ "/help")) ;
raise (Failure "Port already in use")
with
(* It can raise Failure "Connection refused" *)
(try
ignore
- (Http_client.http_get
+ (Http_user_agent.get
("http://127.0.0.1:" ^ string_of_int port ^ "/help"))
with Unix.Unix_error (Unix.ECONNREFUSED, _, _) ->
raise (Failure "Connection refused"))
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" ->
| "/setpassword" ->
let cmd = sprintf "setpassword %s,%s,%s"
(req#param "id")
- (string_of_param_option req "password")
(string_of_param_option req "oldpassword")
+ (string_of_param_option req "password")
in
short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan
| "/setpermission" ->
let res = Uwobo_profiles.get_params pid ?password () in
respond_html
("<html><body><ul>" ^
- String.concat "" (List.map (fun k,v -> "<li>" ^ k ^ " = " ^ v ^ "</li>") res) ^
+ String.concat "" (List.map (fun (k,v) -> "<li><key>" ^ k ^ "</key> = <value>" ^ v ^ "</value></li>") res) ^
"</ul></body></html>") outchan
+ | "/setparams" ->
+ 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")
+ serialized_param_value_list
+ in
+ short_circuit_grandfather_and_client ~cmd ~cmd_pipe ~res_pipe outchan
| "/getparam" ->
let pid = req#param "id" in
let password = try Some (req#param "password") with _ -> None in
match forwhat with
Some forwhat ->
let value = Uwobo_profiles.get_permission pid ?password forwhat in
- respond_html ("<html><body>" ^ (if value then "true" else "false") ^ "</body></html>") outchan
+ respond_html ("<html><body>" ^ (if value then "public" else "private") ^ "</body></html>") outchan
| None -> Http_daemon.respond_error ~code:(`Status (`Client_error `Bad_request)) outchan ;
end
| "/apply" ->
syslogger#log `Debug (sprintf "Parsing input document %s ..." xmluri);
let domImpl = Gdome.domImplementation () in
let input = domImpl#createDocumentFromURI ~uri:xmluri () in
+ if debug then begin
+ let tmp_xml, tmp_uri =
+ let dir =
+ Filename.dirname (Helm_registry.get "uwobo.log_basename")
+ in
+ dir ^ "/input.xml", dir ^ "/input.uri"
+ in
+ ignore (domImpl#saveDocumentToFile ~doc:input ~name:tmp_xml ());
+ let oc = open_out tmp_uri in
+ output_string oc xmluri;
+ close_out oc
+ end;
syslogger#log `Debug "Applying stylesheet chain ...";
(try
let (write_result, media_type, encoding) = (* out_channel -> unit *)
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
save_configuration () ;
output_string res_pipe "Done" ;
raise Restart_HTTP_daemon
+ | line when Pcre.pmatch ~rex:setparams_cmd_RE line -> (* /setparams *)
+ stop_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), (deserialize_param_list pv_list)
+ | _ -> assert false
+ in
+ List.iter
+ (fun (key, value) -> Uwobo_profiles.set_param pid ?password ~key ~value ())
+ pv_list ;
+ save_configuration () ;
+ output_string res_pipe "Done" ;
+ raise Restart_HTTP_daemon
| line when Pcre.pmatch ~rex:setprofileparam_cmd_RE line -> (* /setprofileparam *)
stop_http_daemon ();
let pid, password, key, value =
| "write" -> `Write
| "admin" -> `Admin
| _ -> assert false
- and bool_of_string s = "true" = s
+ and bool_of_string s = "public" = s
in
let pid, password, forwhat, value =
match Pcre.split ~pat:"," (Pcre.replace ~rex:setpermission_cmd_RE line) with
(sprintf "Ignoring invalid interprocess command: '%s'" cmd))
done
with
- Restart_HTTP_daemon ->
+ | Restart_HTTP_daemon ->
close_in cmd_pipe; (* these calls close also fds *)
close_out res_pipe
+ | Sys.Break as exn -> raise exn
| e -> (* Should we return a 404 error here? Maybe... (how?) *)
output_string res_pipe (Printexc.to_string e);
close_in cmd_pipe; (* these calls close also fds *)
projects / helm.git / blobdiff