Factor out Http auth parse logic, test it. (#4211)

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

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

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

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)

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