From 6ff59671097f8c361dff76431b7d252632b251a0 Mon Sep 17 00:00:00 2001
From: Lin Liu <lin.liu@citrix.com>
Date: Mon, 26 Jul 2021 10:22:17 +0000
Subject: [PATCH] CA-356901: Escape subject before perform ldap query

Signed-off-by: Lin Liu <lin.liu@citrix.com>
---
 ocaml/xapi/extauth_plugin_ADwinbind.ml | 77 ++++++++++++--------------
 1 file changed, 36 insertions(+), 41 deletions(-)

diff --git a/ocaml/xapi/extauth_plugin_ADwinbind.ml b/ocaml/xapi/extauth_plugin_ADwinbind.ml
index 9ba93557714..ab4262709db 100644
--- a/ocaml/xapi/extauth_plugin_ADwinbind.ml
+++ b/ocaml/xapi/extauth_plugin_ADwinbind.ml
@@ -90,19 +90,18 @@ 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
   type user = {
@@ -223,7 +222,7 @@ 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)
@@ -231,7 +230,7 @@ module Ldap = struct
     [|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 +258,8 @@ 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 = String.escaped name in
     let query = Printf.sprintf "(|(sAMAccountName=%s)(name=%s))" name name in
     let args =
       [
@@ -676,11 +676,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 +714,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 +881,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