CA-356901: Escape subject before perform ldap query

Signed-off-by: Lin Liu <[email protected]>

ocaml/tests/test_extauth_plugin_ADwinbind.ml

@@ -112,6 +112,28 @@ let test_domainify_uname =
   |> List.map @@ fun (inp, exp) ->
      (Printf.sprintf "%s -> %s" inp exp, `Quick, check inp exp)
 
+let test_ldap_escape =
+  let open Extauth_plugin_ADwinbind.Ldap in
+  let check str exp () =
+    let msg = Printf.sprintf "%s -> %s" str exp in
+    let escaped = escape str in
+    Alcotest.(check string) msg exp escaped
+  in
+  let matrix =
+    [
+      ({|user|}, {|user|})
+    ; ({|(user)|}, {|\28user\29|})
+    ; ({|(user|}, {|\28user|})
+    ; ({|user)|}, {|user\29|})
+    ; ({|us\er)|}, {|us\5der\29|})
+    ; ({|user)1|}, {|user\291|})
+    ; ({|user*|}, {|user\2a|})
+    ]
+  in
+  matrix
+  |> List.map @@ fun (inp, exp) ->
+     (Printf.sprintf "%s -> %s" inp exp, `Quick, check inp exp)
+
 let test_parse_wbinfo_uid_info =
   let open Extauth_plugin_ADwinbind.Wbinfo in
   let string_of_result x =
@@ -424,6 +446,7 @@ let tests =
   ; ("ADwinbind:test_range", Range.tests)
   ; ("ADwinbind:test_parse_value_from_pbis", ParseValueFromPbis.tests)
   ; ("ADwinbind:test_domainify_uname", test_domainify_uname)
+  ; ("ADwinbind:test_ldap_escape", test_ldap_escape)
   ; ("ADwinbind:test_parse_wbinfo_uid_info", test_parse_wbinfo_uid_info)
   ; ("ADwinbind:test_parse_ldap_stdout", test_parse_ldap_stdout)
   ; ( "ADwinbind:test_wbinfo_exception_of_stderr"

ocaml/xapi/extauth_plugin_ADwinbind.ml

@@ -90,21 +90,61 @@ let ntlm_auth uname passwd : (unit, exn) result =
   with _ -> Error (auth_ex uname)
 
 let get_domain_info_from_db () =
-  (fun __context ->
-    let host = Helpers.get_localhost ~__context in
-    let service_name =
-      Db.Host.get_external_auth_service_name ~__context ~self:host
-    in
-    let workgroup, netbios_name =
-      Db.Host.get_external_auth_configuration ~__context ~self:host |> fun l ->
-      (List.assoc_opt "workgroup" l, List.assoc_opt "netbios_name" l)
-    in
-    {service_name; workgroup; netbios_name}
-    )
-  |> Server_helpers.exec_with_new_task
-       "retrieving external auth domain workgroup"
+  Server_helpers.exec_with_new_task "retrieving external auth domain workgroup"
+  @@ fun __context ->
+  let host = Helpers.get_localhost ~__context in
+  let service_name =
+    Db.Host.get_external_auth_service_name ~__context ~self:host
+  in
+  let workgroup, netbios_name =
+    Db.Host.get_external_auth_configuration ~__context ~self:host
+    |> fun config ->
+    (List.assoc_opt "workgroup" config, List.assoc_opt "netbios_name" config)
+  in
+  {service_name; workgroup; netbios_name}
 
 module Ldap = struct
+  module Escape = struct
+    (*
+     * Escape characters according to
+     * https://docs.microsoft.com/en-gb/windows/win32/adsi/search-filter-syntax?redirectedfrom=MSDN#special-characters
+     * *)
+
+    let reg_star = {|*|} |> Re.str |> Re.compile
+
+    let reg_left_bracket = {|(|} |> Re.str |> Re.compile
+
+    let reg_right_bracket = {|)|} |> Re.str |> Re.compile
+
+    let reg_backward_slash = {|\|} |> Re.str |> Re.compile
+
+    let reg_null = "\000" |> Re.str |> Re.compile
+
+    let reg_slash = {|/|} |> Re.str |> Re.compile
+
+    let escape_map =
+      [
+        (* backward slash goes first as others will include backward slash*)
+        (reg_backward_slash, {|\5d|})
+      ; (reg_star, {|\2a|})
+      ; (reg_left_bracket, {|\28|})
+      ; (reg_right_bracket, {|\29|})
+      ; (reg_null, {|\00|})
+      ; (reg_slash, {|\2f|})
+      ]
+
+    let escape str =
+      List.fold_left
+        (fun acc element ->
+          let reg = fst element in
+          let value = snd element in
+          Re.replace_string reg ~by:value acc
+          )
+        str escape_map
+  end
+
+  let escape str = Escape.escape str
+
   type user = {
       name: string
     ; display_name: string
@@ -223,15 +263,15 @@ module Ldap = struct
       ; password_expired= logand user_account_control passw_expire_bit <> 0l
       }
 
-  let env_of_lookup domain_netbios =
+  let env_of_krb5 domain_netbios =
     let domain_krb5_cfg =
       Filename.concat domain_krb5_dir
         (Printf.sprintf "krb5.conf.%s" domain_netbios)
     in
     [|Printf.sprintf "KRB5_CONFIG=%s" domain_krb5_cfg|]
 
   let query_user sid domain_netbios kdc =
-    let env = env_of_lookup domain_netbios in
+    let env = env_of_krb5 domain_netbios in
     let* stdout =
       try
         (* Query KDC instead of use domain here
@@ -259,7 +299,9 @@ module Ldap = struct
 
   let query_sid ~name ~kdc ~domain_netbios =
     let key = "objectSid" in
-    let env = env_of_lookup domain_netbios in
+    let env = env_of_krb5 domain_netbios in
+    let name = escape name in
+    (* Escape name to avoid injection detection *)
     let query = Printf.sprintf "(|(sAMAccountName=%s)(name=%s))" name name in
     let args =
       [
@@ -676,11 +718,9 @@ let from_config ~name ~err_msg ~config_params =
 let all_number_re = Re.Perl.re {|^\d+$|} |> Re.Perl.compile
 
 let get_localhost_name () =
-  (fun __context ->
-    Helpers.get_localhost ~__context |> fun host ->
-    Db.Host.get_hostname ~__context ~self:host
-    )
-  |> Server_helpers.exec_with_new_task "retrieving hostname"
+  Server_helpers.exec_with_new_task "retrieving hostname" @@ fun __context ->
+  Helpers.get_localhost ~__context |> fun host ->
+  Db.Host.get_hostname ~__context ~self:host
 
 let assert_hostname_valid ~hostname =
   let all_numbers = Re.matches all_number_re hostname <> [] in
@@ -716,13 +756,12 @@ let persist_extauth_config ~domain ~user ~ou_conf ~workgroup ~netbios_name =
         ]
         @ ou_conf
   in
-  (fun __context ->
-    Helpers.get_localhost ~__context |> fun self ->
-    Db.Host.set_external_auth_configuration ~__context ~self ~value ;
-    Db.Host.get_name_label ~__context ~self
-    |> debug "update external_auth_configuration for host %s"
-    )
-  |> Server_helpers.exec_with_new_task "update external_auth_configuration"
+  Server_helpers.exec_with_new_task "update external_auth_configuration"
+  @@ fun __context ->
+  Helpers.get_localhost ~__context |> fun self ->
+  Db.Host.set_external_auth_configuration ~__context ~self ~value ;
+  Db.Host.get_name_label ~__context ~self
+  |> debug "update external_auth_configuration for host %s"
 
 let disable_machine_account ~service_name = function
   | Some u, Some p -> (
@@ -884,21 +923,19 @@ module ClosestKdc = struct
         Error e
 
   let update_db ~domain ~kdc =
-    (fun __context ->
-      let self = Helpers.get_localhost ~__context in
-      Db.Host.get_external_auth_configuration ~__context ~self |> fun value ->
-      (domain, kdc) :: List.remove_assoc domain value |> fun value ->
-      Db.Host.set_external_auth_configuration ~__context ~self ~value
-      )
-    |> Server_helpers.exec_with_new_task "update domain closest kdc"
+    Server_helpers.exec_with_new_task "update domain closest kdc"
+    @@ fun __context ->
+    let self = Helpers.get_localhost ~__context in
+    Db.Host.get_external_auth_configuration ~__context ~self |> fun value ->
+    (domain, kdc) :: List.remove_assoc domain value |> fun value ->
+    Db.Host.set_external_auth_configuration ~__context ~self ~value
 
   let from_db domain =
-    (fun __context ->
-      let self = Helpers.get_localhost ~__context in
-      Db.Host.get_external_auth_configuration ~__context ~self
-      |> List.assoc_opt domain
-      )
-    |> Server_helpers.exec_with_new_task "query domain closest kdc"
+    Server_helpers.exec_with_new_task "query domain closest kdc"
+    @@ fun __context ->
+    let self = Helpers.get_localhost ~__context in
+    Db.Host.get_external_auth_configuration ~__context ~self
+    |> List.assoc_opt domain
 
   let lookup domain =
     try

ocaml/xapi/extauth_plugin_ADwinbind.mli

@@ -61,6 +61,8 @@ module Ldap : sig
   val string_of_user : user -> string
 
   val parse_user : string -> (user, string) result
+
+  val escape : string -> string
 end
 
 module Migrate_from_pbis : sig