diff --git a/src/core/harbor/harbor.ml b/src/core/harbor/harbor.ml index aed4436454..83ffffef9a 100644 --- a/src/core/harbor/harbor.ml +++ b/src/core/harbor/harbor.ml @@ -361,11 +361,9 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct let websocket_error n msg = Websocket.to_string (`Close (Some (n, msg))) let parse_icy_request_line ~port h r = - let auth_data = Re.Pcre.split ~rex:(Re.Pcre.regexp ":") r in - let requested_user, password = - match auth_data with - | user :: password :: _ -> (user, password) - | _ -> ("", r) + let { Liq_http.user = requested_user; password } = + try Liq_http.parse_auth r + with Not_found -> { Liq_http.user = ""; password = r } in let* s = try Duppy.Monad.return (find_source "/" (port - 1)) @@ -451,14 +449,11 @@ module Make (T : Transport_t) : T with type socket = T.socket = struct let auth = assoc_uppercase "AUTHORIZATION" headers in let data = Re.Pcre.split ~rex:(Re.Pcre.regexp "[ \t]+") auth in match data with - | "Basic" :: x :: _ -> ( - let auth_data = - Re.Pcre.split ~rex:(Re.Pcre.regexp ":") - (Lang_string.decode64 x) + | "Basic" :: x :: _ -> + let { Liq_http.user; password } = + Liq_http.parse_auth (Lang_string.decode64 x) in - match auth_data with - | x :: y :: _ -> (x, y) - | _ -> raise Not_found) + (user, password) | _ -> raise Not_found with Not_found -> ( match query with diff --git a/src/core/tools/liq_http.ml b/src/core/tools/liq_http.ml index d6eae3835c..4fa9466c9e 100644 --- a/src/core/tools/liq_http.ml +++ b/src/core/tools/liq_http.ml @@ -206,3 +206,11 @@ let set_socket_default ~read_timeout ~write_timeout fd = Unix.set_close_on_exec fd; Unix.setsockopt_float fd Unix.SO_RCVTIMEO read_timeout; Unix.setsockopt_float fd Unix.SO_SNDTIMEO write_timeout + +type auth = { user : string; password : string } + +let parse_auth s = + match Re.Pcre.split ~rex:(Re.Pcre.regexp ":") s with + | user :: (_ :: _ as password) -> + { user; password = String.concat ":" password } + | _ -> raise Not_found diff --git a/src/core/tools/liq_http.mli b/src/core/tools/liq_http.mli index 3351886686..d47bcde1e2 100644 --- a/src/core/tools/liq_http.mli +++ b/src/core/tools/liq_http.mli @@ -76,5 +76,10 @@ val read : timeout:float -> socket -> int -> string (** Read [len] bytes *) val really_read : timeout:float -> socket -> int -> string -(* Read chunked data. *) +(** Read chunked data. *) val read_chunked : timeout:float -> socket -> string * int + +type auth = { user : string; password : string } + +(** Split authentication string. Raises [Not_found] if failed. *) +val parse_auth : string -> auth diff --git a/tests/core/dune.inc b/tests/core/dune.inc index 2a45450f8b..d1ac0fc5e3 100644 --- a/tests/core/dune.inc +++ b/tests/core/dune.inc @@ -83,6 +83,20 @@ (action (run %{generator_test} ))) +(executable + (name http_test) + (modules http_test) + (libraries liquidsoap_core liquidsoap_optionals)) + +(rule + (alias citest) + (package liquidsoap) + (deps + + (:http_test http_test.exe)) + (action (run %{http_test} ))) + + (executable (name is_url) (modules is_url) diff --git a/tests/core/http_test.ml b/tests/core/http_test.ml new file mode 100644 index 0000000000..0fb43a09fa --- /dev/null +++ b/tests/core/http_test.ml @@ -0,0 +1,4 @@ +let () = + let { Liq_http.user; password } = Liq_http.parse_auth "foo:bar:gni" in + assert (user = "foo"); + assert (password = "bar:gni")