Merge pull request #5901 from contificate/CP-50426

CP-50426: Trace external authentication modules

Author: Colin

ocaml/tests/testauthx.ml

@@ -20,19 +20,22 @@ let usage () =
   exit 1
 
 let _ =
+  let __context = Context.make __MODULE__ in
   if Array.length Sys.argv <> 3 then usage () ;
   let username = Sys.argv.(1) and password = Sys.argv.(2) in
   let hr x = print_endline ("-----------------------------\n" ^ x) in
   (* should return 2037 *)
   hr ("TEST 1a. Authx.get_subject_identifier " ^ username) ;
-  let userid = AuthX.methods.get_subject_identifier username in
+  let userid = AuthX.methods.get_subject_identifier ~__context username in
   print_endline ("userid=" ^ userid) ;
   hr
     ("TEST 1b. AuthX.methods.get_subject_identifier "
     ^ username
     ^ "_werq (unknown subject)"
     ) ;
-  try print_endline (AuthX.methods.get_subject_identifier (username ^ "_werq"))
+  try
+    print_endline
+      (AuthX.methods.get_subject_identifier ~__context (username ^ "_werq"))
   with Not_found -> (
     print_endline "subject Not_found, as expected" ;
     (* should return a list of groups that subjectid 1000 (a user) belongs to *)
@@ -42,7 +45,7 @@ let _ =
       ^ " (a user subject)"
       ) ;
     let conc x y = x ^ "," ^ y in
-    let groupid_list = AuthX.methods.query_group_membership userid in
+    let groupid_list = AuthX.methods.query_group_membership ~__context userid in
     print_endline (List.fold_left conc "" groupid_list) ;
     (* should return a list of groups that subjectid 10024 (a group) belongs to *)
     let agroup = List.hd groupid_list in
@@ -52,23 +55,31 @@ let _ =
       ^ " (a group subject)"
       ) ;
     print_endline
-      (List.fold_left conc "" (AuthX.methods.query_group_membership agroup)) ;
+      (List.fold_left conc ""
+         (AuthX.methods.query_group_membership ~__context agroup)
+      ) ;
     hr "TEST 2c. AuthX.methods.query_group_membership u999 (unknown subject)" ;
     try
       print_endline
-        (List.fold_left conc "" (AuthX.methods.query_group_membership "u999"))
+        (List.fold_left conc ""
+           (AuthX.methods.query_group_membership ~__context "u999")
+        )
     with Not_found -> (
       print_endline "subject Not_found, as expected." ;
       hr "TEST 2d. AuthX.methods.query_group_membership a999 (unknown subject)" ;
       try
         print_endline
-          (List.fold_left conc "" (AuthX.methods.query_group_membership "a999"))
+          (List.fold_left conc ""
+             (AuthX.methods.query_group_membership ~__context "a999")
+          )
       with Not_found -> (
         print_endline "subject Not_found, as expected." ;
         hr "TEST 2e. AuthX.methods.query_group_membership 999 (unknown subject)" ;
         try
           print_endline
-            (List.fold_left conc "" (AuthX.methods.query_group_membership "999"))
+            (List.fold_left conc ""
+               (AuthX.methods.query_group_membership ~__context "999")
+            )
         with Not_found -> (
           print_endline "subject Not_found, as expected." ;
           (* should return a list with information about subject_id 1000 (a user)*)
@@ -77,7 +88,9 @@ let _ =
             ^ userid
             ^ " (a user)"
             ) ;
-          let infolist1 = AuthX.methods.query_subject_information userid in
+          let infolist1 =
+            AuthX.methods.query_subject_information ~__context userid
+          in
           for i = 0 to List.length infolist1 - 1 do
             let print_elems (e1, e2) = print_endline (e1 ^ ": " ^ e2) in
             print_elems (List.nth infolist1 i)
@@ -88,7 +101,9 @@ let _ =
             ^ agroup
             ^ " (a group)"
             ) ;
-          let infolist1 = AuthX.methods.query_subject_information agroup in
+          let infolist1 =
+            AuthX.methods.query_subject_information ~__context agroup
+          in
           for i = 0 to List.length infolist1 - 1 do
             let print_elems (e1, e2) = print_endline (e1 ^ ": " ^ e2) in
             print_elems (List.nth infolist1 i)
@@ -98,7 +113,9 @@ let _ =
             "TEST 3c. AuthX.methods.query_subject_information u999 (unknown \
              subject)" ;
           try
-            let infolist1 = AuthX.methods.query_subject_information "u999" in
+            let infolist1 =
+              AuthX.methods.query_subject_information ~__context "u999"
+            in
             for i = 0 to List.length infolist1 - 1 do
               let print_elems (e1, e2) = print_endline (e1 ^ ": " ^ e2) in
               print_elems (List.nth infolist1 i)
@@ -110,7 +127,9 @@ let _ =
               "TEST 3d. AuthX.methods.query_subject_information a999 (unknown \
                subject)" ;
             try
-              let infolist1 = AuthX.methods.query_subject_information "a999" in
+              let infolist1 =
+                AuthX.methods.query_subject_information ~__context "a999"
+              in
               for i = 0 to List.length infolist1 - 1 do
                 let print_elems (e1, e2) = print_endline (e1 ^ ": " ^ e2) in
                 print_elems (List.nth infolist1 i)
@@ -122,7 +141,9 @@ let _ =
                 "TEST 3e. AuthX.methods.query_subject_information 999 (unknown \
                  subject)" ;
               try
-                let infolist1 = AuthX.methods.query_subject_information "999" in
+                let infolist1 =
+                  AuthX.methods.query_subject_information ~__context "999"
+                in
                 for i = 0 to List.length infolist1 - 1 do
                   let print_elems (e1, e2) = print_endline (e1 ^ ": " ^ e2) in
                   print_elems (List.nth infolist1 i)
@@ -134,8 +155,8 @@ let _ =
                   ^ username
                   ) ;
                 print_endline
-                  (AuthX.methods.authenticate_username_password username
-                     password
+                  (AuthX.methods.authenticate_username_password ~__context
+                     username password
                   )
             )
           )

ocaml/xapi/auth_signature.ml

@@ -67,20 +67,21 @@ type t = {
        	 the auth module/service itself -- e.g. maybe a SID or something in the AD case).
        	 Raises auth_failure if authentication is not successful
     *)
-    authenticate_username_password: string -> string -> string
+    authenticate_username_password:
+      __context:Context.t -> string -> string -> string
   ; (* subject_id Authenticate_ticket(string ticket)
 
        	 As above but uses a ticket as credentials (i.e. for single sign-on)
     *)
-    authenticate_ticket: string -> string
+    authenticate_ticket: __context:Context.t -> string -> string
   ; (* subject_id get_subject_identifier(string subject_name)
 
        	 Takes a subject_name (as may be entered into the XenCenter UI when defining subjects --
        	 see Access Control wiki page); and resolves it to a subject_id against the external
        	 auth/directory service.
        	 Raises Not_found if authentication is not succesful.
     *)
-    get_subject_identifier: string -> string
+    get_subject_identifier: __context:Context.t -> string -> string
   ; (* ((string*string) list) query_subject_information(string subject_identifier)
 
        	 Takes a subject_identifier and returns the user record from the directory service as
@@ -91,15 +92,16 @@ type t = {
        	 it's a string*string list anyway for possible future expansion.
        	 Raises Not_found if subject_id cannot be resolved by external auth service
     *)
-    query_subject_information: string -> (string * string) list
+    query_subject_information:
+      __context:Context.t -> string -> (string * string) list
   ; (* (string list) query_group_membership(string subject_identifier)
 
        	 Takes a subject_identifier and returns its group membership (i.e. a list of subject
        	 identifiers of the groups that the subject passed in belongs to). The set of groups returned
        	 _must_ be transitively closed wrt the is_member_of relation if the external directory service
        	 supports nested groups (as AD does for example)
     *)
-    query_group_membership: string -> string list
+    query_group_membership: __context:Context.t -> string -> string list
   ; (*
 	In addition, there are some event hooks that auth modules implement as follows:
       *)
@@ -118,26 +120,26 @@ type t = {
        	 explicitly filter any one-time credentials [like AD username/password for example] that it
        	 does not need long-term.]
     *)
-    on_enable: (string * string) list -> unit
+    on_enable: __context:Context.t -> (string * string) list -> unit
   ; (* unit on_disable()
 
        	 Called internally by xapi _on each host_ when a client disables an auth service via the XenAPI.
        	 The hook will be called _before_ the Pool configuration fields relating to the external-auth
        	 service are cleared (i.e. so you can access the config params you need from the pool metadata
        	 within the body of the on_disable method)
     *)
-    on_disable: (string * string) list -> unit
+    on_disable: __context:Context.t -> (string * string) list -> unit
   ; (* unit on_xapi_initialize(bool system_boot)
 
        	 Called internally by xapi whenever it starts up. The system_boot flag is true iff xapi is
        	 starting for the first time after a host boot
     *)
-    on_xapi_initialize: bool -> unit
+    on_xapi_initialize: __context:Context.t -> bool -> unit
   ; (* unit on_xapi_exit()
 
        	 Called internally when xapi is doing a clean exit.
     *)
-    on_xapi_exit: unit -> unit
+    on_xapi_exit: __context:Context.t -> unit -> unit
 }
 
 (* Auth modules must implement this signature:*)

ocaml/xapi/authx.ml

@@ -19,6 +19,8 @@ module D = Debug.Make (struct let name = "extauth_plugin_PAM_NSS" end)
 
 open D
 
+let ( let@ ) = ( @@ )
+
 module AuthX : Auth_signature.AUTH_MODULE = struct
   (*
    * External Authentication Plugin component
@@ -113,7 +115,8 @@ module AuthX : Auth_signature.AUTH_MODULE = struct
      	auth/directory service.
      	Raises Not_found if authentication is not succesful.
   *)
-  let get_subject_identifier subject_name =
+  let get_subject_identifier ~__context subject_name =
+    let@ __context = Context.with_tracing ~__context __FUNCTION__ in
     try (* looks up list of users*)
         "u" ^ getent_idbyname "passwd" subject_name
     with Not_found ->
@@ -131,15 +134,16 @@ module AuthX : Auth_signature.AUTH_MODULE = struct
      	Raises auth_failure if authentication is not successful
   *)
 
-  let authenticate_username_password username password =
+  let authenticate_username_password ~__context username password =
+    let@ __context = Context.with_tracing ~__context __FUNCTION__ in
     (* we try to authenticate against our user database using PAM *)
     let () =
       try
         Pam.authenticate username password
         (* no exception raised, then authentication succeeded *)
       with Failure msg -> raise (Auth_signature.Auth_failure msg)
     in
-    try get_subject_identifier username
+    try get_subject_identifier ~__context username
     with Not_found ->
       raise
         (Auth_signature.Auth_failure
@@ -155,7 +159,7 @@ module AuthX : Auth_signature.AUTH_MODULE = struct
   *)
   (* not implemented now, not needed for our tests, only for a *)
   (* future single sign-on feature *)
-  let authenticate_ticket _tgt =
+  let authenticate_ticket ~__context:_ _tgt =
     failwith "authx authenticate_ticket not implemented"
 
   (* ((string*string) list) query_subject_information(string subject_identifier)
@@ -168,7 +172,8 @@ module AuthX : Auth_signature.AUTH_MODULE = struct
      	it's a string*string list anyway for possible future expansion.
      	Raises Not_found if subject_id cannot be resolved by external auth service
   *)
-  let query_subject_information subject_identifier =
+  let query_subject_information ~__context subject_identifier =
+    let@ __context = Context.with_tracing ~__context __FUNCTION__ in
     (* we are expecting an id such as u0, g0, u123 etc *)
     if String.length subject_identifier < 2 then raise Not_found ;
     match subject_identifier.[0] with
@@ -246,7 +251,8 @@ module AuthX : Auth_signature.AUTH_MODULE = struct
   *)
   (* in unix, groups cannot contain groups, so we just verify the groups a user *)
   (* belongs to and, if that fails, if some group has the required identifier *)
-  let query_group_membership subject_identifier =
+  let query_group_membership ~__context subject_identifier =
+    let@ __context = Context.with_tracing ~__context __FUNCTION__ in
     (* 1. first we try to see if our subject identifier is a user id...*)
     let sanitized_subject_id = String.escaped subject_identifier in
     (* we are expecting an id such as u0, g0, u123 etc *)
@@ -303,7 +309,7 @@ module AuthX : Auth_signature.AUTH_MODULE = struct
      		explicitly filter any one-time credentials [like AD username/password for example] that it
      		does not need long-term.]
   *)
-  let on_enable _config_params =
+  let on_enable ~__context:_ _config_params =
     (* nothing to do in this unix plugin, we always have /etc/passwd and /etc/group *)
     ()
 
@@ -314,7 +320,7 @@ module AuthX : Auth_signature.AUTH_MODULE = struct
      	service are cleared (i.e. so you can access the config params you need from the pool metadata
      	within the body of the on_disable method)
   *)
-  let on_disable _config_params =
+  let on_disable ~__context:_ _config_params =
     (* nothing to disable in this unix plugin, we should not disable /etc/passwd and /etc/group:) *)
     ()
 
@@ -323,29 +329,30 @@ module AuthX : Auth_signature.AUTH_MODULE = struct
      	Called internally by xapi whenever it starts up. The system_boot flag is true iff xapi is
      	starting for the first time after a host boot
   *)
-  let on_xapi_initialize _system_boot =
+  let on_xapi_initialize ~__context:_ _system_boot =
     (* again, nothing to be initialized here in this unix plugin *)
     ()
 
   (* unit on_xapi_exit()
 
      	Called internally when xapi is doing a clean exit.
   *)
-  let on_xapi_exit () =
+  let on_xapi_exit ~__context:_ () =
     (* nothing to do here in this unix plugin *)
     ()
 
   (* Implement the single value required for the module signature *)
   let methods =
-    {
-      Auth_signature.authenticate_username_password
-    ; Auth_signature.authenticate_ticket
-    ; Auth_signature.get_subject_identifier
-    ; Auth_signature.query_subject_information
-    ; Auth_signature.query_group_membership
-    ; Auth_signature.on_enable
-    ; Auth_signature.on_disable
-    ; Auth_signature.on_xapi_initialize
-    ; Auth_signature.on_xapi_exit
-    }
+    Auth_signature.
+      {
+        authenticate_username_password
+      ; authenticate_ticket
+      ; get_subject_identifier
+      ; query_subject_information
+      ; query_group_membership
+      ; on_enable
+      ; on_disable
+      ; on_xapi_initialize
+      ; on_xapi_exit
+      }
 end