diff --git a/ocaml/libs/http-lib/http.ml b/ocaml/libs/http-lib/http.ml index 09dc4a66ed4..b6b4791e06f 100644 --- a/ocaml/libs/http-lib/http.ml +++ b/ocaml/libs/http-lib/http.ml @@ -923,7 +923,7 @@ module Url = struct in let data = { - uri= (match Uri.path uri with "" -> "/" | path -> path) + uri= (match Uri.path_unencoded uri with "" -> "/" | path -> path) ; query_params= Uri.query uri |> List.map query } in @@ -936,7 +936,7 @@ module Url = struct | Some "https" -> (scheme ~ssl:true, data) | Some "file" -> - let scheme = File {path= Uri.path uri} in + let scheme = File {path= Uri.path_unencoded uri} in (scheme, {data with uri= "/"}) | _ -> failwith "unsupported URI scheme" diff --git a/ocaml/libs/http-lib/http_svr.ml b/ocaml/libs/http-lib/http_svr.ml index 26ad35f712f..7c270874a96 100644 --- a/ocaml/libs/http-lib/http_svr.ml +++ b/ocaml/libs/http-lib/http_svr.ml @@ -374,7 +374,7 @@ let request_of_bio_exn ~proxy_seen ~read_timeout ~total_timeout ~max_length bio (* Request-Line = Method SP Request-URI SP HTTP-Version CRLF *) let uri_t = Uri.of_string uri in if uri_t = Uri.empty then raise Http_parse_failure ; - let uri = Uri.path uri_t |> Uri.pct_decode in + let uri = Uri.path_unencoded uri_t in let query = Uri.query uri_t |> kvlist_flatten in let m = Http.method_t_of_string meth in let version = diff --git a/ocaml/libs/open-uri/open_uri.ml b/ocaml/libs/open-uri/open_uri.ml index 84cbd3b6ab5..2e3cda05413 100644 --- a/ocaml/libs/open-uri/open_uri.ml +++ b/ocaml/libs/open-uri/open_uri.ml @@ -74,7 +74,7 @@ let with_open_uri ?verify_cert uri f = ) ) | Some "file" -> - let filename = Uri.path_and_query uri in + let filename = Uri.path_and_query uri |> Uri.pct_decode in let sockaddr = Unix.ADDR_UNIX filename in let s = Unix.socket Unix.PF_UNIX Unix.SOCK_STREAM 0 in finally diff --git a/ocaml/message-switch/switch/switch_main.ml b/ocaml/message-switch/switch/switch_main.ml index 583baf6e594..7fb907d1cb2 100644 --- a/ocaml/message-switch/switch/switch_main.ml +++ b/ocaml/message-switch/switch/switch_main.ml @@ -222,7 +222,7 @@ let make_server config trace_config = let open Message_switch_core.Protocol in Cohttp_lwt.Body.to_string body >>= fun body -> let uri = Cohttp.Request.uri req in - let path = Uri.path uri in + let path = Uri.path_unencoded uri in match In.of_request body (Cohttp.Request.meth req) path with | None -> error "<- [unparsable request; path = %s; body = %s]" path diff --git a/ocaml/nbd/src/main.ml b/ocaml/nbd/src/main.ml index d8f67a8c49a..25919464839 100644 --- a/ocaml/nbd/src/main.ml +++ b/ocaml/nbd/src/main.ml @@ -59,7 +59,7 @@ let handle_connection fd tls_role = >>= fun session_id -> f uri rpc session_id in let serve t uri rpc session_id = - let path = Uri.path uri in + let path = Uri.path_unencoded uri in (* note preceeding / *) let vdi_uuid = if path <> "" then String.sub path 1 (String.length path - 1) else path diff --git a/ocaml/vhd-tool/src/impl.ml b/ocaml/vhd-tool/src/impl.ml index 54058316625..6052e77eb52 100644 --- a/ocaml/vhd-tool/src/impl.ml +++ b/ocaml/vhd-tool/src/impl.ml @@ -787,9 +787,9 @@ let endpoint_of_string = function if he = [] then raise Not_found ; return (Sockaddr (List.hd he).Unix.ai_addr) | Some "unix", _ -> - return (Sockaddr (Lwt_unix.ADDR_UNIX (Uri.path uri'))) + return (Sockaddr (Lwt_unix.ADDR_UNIX (Uri.path_unencoded uri'))) | Some "file", _ -> - return (File (Uri.path uri')) + return (File (Uri.path_unencoded uri')) | Some "http", _ -> return (Http uri') | Some "https", _ -> diff --git a/ocaml/xapi-guard/lib/server_interface.ml b/ocaml/xapi-guard/lib/server_interface.ml index d58a934f5f2..c6f70769313 100644 --- a/ocaml/xapi-guard/lib/server_interface.ml +++ b/ocaml/xapi-guard/lib/server_interface.ml @@ -77,9 +77,8 @@ let serve_forever_lwt path callback = Lwt.return cleanup let serve_forever_lwt_callback rpc_fn path _ req body = - let uri = Cohttp.Request.uri req in - match (Cohttp.Request.meth req, Uri.path uri) with - | `POST, _ -> + match Cohttp.Request.meth req with + | `POST -> let* body = Cohttp_lwt.Body.to_string body in let* response = Xapi_guard.Dorpc.wrap_rpc err (fun () -> @@ -91,7 +90,7 @@ let serve_forever_lwt_callback rpc_fn path _ req body = in let body = response |> Xmlrpc.string_of_response in Cohttp_lwt_unix.Server.respond_string ~status:`OK ~body () - | _, _ -> + | _ -> let body = "Not allowed" |> Rpc.rpc_of_string @@ -142,7 +141,7 @@ let serve_forever_lwt_callback_vtpm ~cache mutex (read, persist) vm_uuid _ req *) Lwt_mutex.with_lock mutex @@ fun () -> (* TODO: some logging *) - match (Cohttp.Request.meth req, Uri.path uri) with + match (Cohttp.Request.meth req, Uri.path_unencoded uri) with | `GET, path when path <> "/" -> let key = Tpm.key_of_swtpm path in let* body = read (vm_uuid, timestamp, key) in diff --git a/ocaml/xapi-idl/lib/xcp_service.ml b/ocaml/xapi-idl/lib/xcp_service.ml index 69217d8328c..d6c3cae14db 100644 --- a/ocaml/xapi-idl/lib/xcp_service.ml +++ b/ocaml/xapi-idl/lib/xcp_service.ml @@ -501,8 +501,8 @@ let http_handler call_of_string string_of_response process s = | `Invalid x -> debug "Failed to read HTTP request. Got: '%s'" x | `Ok req -> ( - match (Cohttp.Request.meth req, Uri.path (Cohttp.Request.uri req)) with - | `POST, _ -> ( + match Cohttp.Request.meth req with + | `POST -> ( let headers = Cohttp.Request.headers req in match Cohttp.Header.get headers "content-length" with | None -> @@ -535,7 +535,7 @@ let http_handler call_of_string string_of_response process s = (fun t -> Response.write_body t response_txt) response oc ) - | _, _ -> + | _ -> let content_length = 0 in let headers = Cohttp.Header.of_list diff --git a/ocaml/xapi-storage-script/examples/volume/org.xen.xcp.storage.plainlvm/common.ml b/ocaml/xapi-storage-script/examples/volume/org.xen.xcp.storage.plainlvm/common.ml index 298099be057..018c133c8dd 100644 --- a/ocaml/xapi-storage-script/examples/volume/org.xen.xcp.storage.plainlvm/common.ml +++ b/ocaml/xapi-storage-script/examples/volume/org.xen.xcp.storage.plainlvm/common.ml @@ -333,7 +333,7 @@ let vg_of_uri uri = let uri' = Uri.of_string uri in match Uri.scheme uri' with | Some "vg" -> - let vg = Uri.path uri' in + let vg = Uri.path_unencoded uri' in if vg <> "" && vg.[0] = '/' then String.sub vg 1 (String.length vg - 1) else diff --git a/ocaml/xapi-storage-script/main.ml b/ocaml/xapi-storage-script/main.ml index b9542fd1963..7420545205f 100644 --- a/ocaml/xapi-storage-script/main.ml +++ b/ocaml/xapi-storage-script/main.ml @@ -977,7 +977,7 @@ let bind ~volume_script_dir = let uri = Uri.of_string datasource in match Uri.scheme uri with | Some "xeno+shm" -> ( - let uid = Uri.path uri in + let uid = Uri.path_unencoded uri in let uid = if String.length uid > 1 then String.sub uid ~pos:1 ~len:(String.length uid - 1) @@ -1024,7 +1024,7 @@ let bind ~volume_script_dir = let uri = Uri.of_string datasource in match Uri.scheme uri with | Some "xeno+shm" -> ( - let uid = Uri.path uri in + let uid = Uri.path_unencoded uri in let uid = if String.length uid > 1 then String.sub uid ~pos:1 ~len:(String.length uid - 1) diff --git a/ocaml/xe-cli/newcli.ml b/ocaml/xe-cli/newcli.ml index 9be987f028b..520d43e0061 100644 --- a/ocaml/xe-cli/newcli.ml +++ b/ocaml/xe-cli/newcli.ml @@ -135,7 +135,7 @@ let parse_url url = let ( let* ) = Option.bind in let* scheme = Uri.scheme uri in let* host = Uri.host uri in - let path = Uri.path_and_query uri in + let path = Uri.path_and_query uri |> Uri.pct_decode in Some (scheme, host, path) in match parse (Uri.of_string url) with diff --git a/ocaml/xen-api-client/lwt/xen_api_lwt_unix.ml b/ocaml/xen-api-client/lwt/xen_api_lwt_unix.ml index 863f32f0829..a69e9423087 100644 --- a/ocaml/xen-api-client/lwt/xen_api_lwt_unix.ml +++ b/ocaml/xen-api-client/lwt/xen_api_lwt_unix.ml @@ -66,7 +66,7 @@ module Lwt_unix_IO = struct let open_connection uri = ( match Uri.scheme uri with | Some "file" -> - return (Unix.PF_UNIX, Unix.ADDR_UNIX (Uri.path uri), false) + return (Unix.PF_UNIX, Unix.ADDR_UNIX (Uri.path_unencoded uri), false) | Some "http+unix" -> return (Unix.PF_UNIX, Unix.ADDR_UNIX (Uri.host_with_default uri), false) | Some "http" | Some "https" -> diff --git a/ocaml/xenopsd/lib/xenops_server.ml b/ocaml/xenopsd/lib/xenops_server.ml index c7fc910ea33..71ad563ed19 100644 --- a/ocaml/xenopsd/lib/xenops_server.ml +++ b/ocaml/xenopsd/lib/xenops_server.ml @@ -2629,7 +2629,7 @@ and perform_exn ?subtask ?result (op : operation) (t : Xenops_task.task_handle) let make_url snippet id_str = Uri.make ?scheme:(Uri.scheme url) ?host:(Uri.host url) ?port:(Uri.port url) - ~path:(Uri.path url ^ snippet ^ id_str) + ~path:(Uri.path_unencoded url ^ snippet ^ id_str) ~query:(Uri.query url) () in (* CA-78365: set the memory dynamic range to a single value to stop @@ -3630,7 +3630,7 @@ module VM = struct debug "traceparent: %s" (Option.value ~default:"(none)" traceparent) ; let id, final_id = (* The URI is /service/xenops/memory/id *) - let bits = Astring.String.cuts ~sep:"/" (Uri.path uri) in + let bits = Astring.String.cuts ~sep:"/" (Uri.path_unencoded uri) in let id = bits |> List.rev |> List.hd in let final_id = match List.assoc_opt "final_id" cookies with @@ -3673,7 +3673,7 @@ module VM = struct (fun () -> let vgpu_id = (* The URI is /service/xenops/migrate-vgpu/id *) - let path = Uri.path uri in + let path = Uri.path_unencoded uri in let bits = Astring.String.cut ~sep:"/" ~rev:true path in let vgpu_id_str = match bits with @@ -3736,7 +3736,7 @@ module VM = struct let dbg = List.assoc "dbg" cookies in Debug.with_thread_associated dbg (fun () -> - let vm = basename (Uri.path uri) in + let vm = basename (Uri.path_unencoded uri) in match context.transferred_fd with | Some fd -> debug "VM.receive_mem: passed fd %d" (Obj.magic fd) ;