Make session errors look less scary in the logs

ocaml/libs/log/debug.ml

@@ -243,7 +243,7 @@ let log_backtrace_internal ?level ?msg e _bt =
 
 let log_backtrace e bt = log_backtrace_internal e bt
 
-let with_thread_associated ?client desc f x =
+let with_thread_associated ?client ?(quiet = false) desc f x =
   ThreadLocalTable.add tasks {desc; client} ;
   let result =
     Backtrace.with_backtraces (fun () ->
@@ -257,11 +257,13 @@ let with_thread_associated ?client desc f x =
   | `Error (exn, bt) ->
       (* This function is a top-level exception handler typically used on fresh
          threads. This is the last chance to do something with the backtrace *)
-      output_log "backtrace" Syslog.Err "error"
-        (Printf.sprintf "%s failed with exception %s" desc
-           (Printexc.to_string exn)
-        ) ;
-      log_backtrace_exn exn bt ;
+      if not quiet then (
+        output_log "backtrace" Syslog.Err "error"
+          (Printf.sprintf "%s failed with exception %s" desc
+             (Printexc.to_string exn)
+          ) ;
+        log_backtrace_exn exn bt
+      ) ;
       raise exn
 
 let with_thread_named name f x =

ocaml/libs/log/debug.mli

@@ -20,7 +20,8 @@ val init_logs : unit -> unit
 
 (** {2 Associate a task to the current actions} *)
 
-val with_thread_associated : ?client:string -> string -> ('a -> 'b) -> 'a -> 'b
+val with_thread_associated :
+  ?client:string -> ?quiet:bool -> string -> ('a -> 'b) -> 'a -> 'b
 (** Do an action with a task name associated with the current thread *)
 
 (** {2 Associate a name to the current thread} *)

ocaml/xapi/server_helpers.ml

@@ -53,7 +53,7 @@ let parameter_count_mismatch_failure func expected received =
 
 (** WARNING: the context is destroyed when execution is finished if the task is not forwarded, in database and not called asynchronous. *)
 let exec_with_context ~__context ~need_complete ?marshaller ?f_forward
-    ?(called_async = false) f =
+    ?(called_async = false) ?quiet f =
   (* Execute fn f in specified __context, marshalling result with "marshaller" *)
   let exec () =
     (* NB:
@@ -95,7 +95,7 @@ let exec_with_context ~__context ~need_complete ?marshaller ?f_forward
   Locking_helpers.Thread_state.with_named_thread
     (TaskHelper.get_name ~__context) (Context.get_task_id __context) (fun () ->
       let client = Context.get_client __context in
-      Debug.with_thread_associated ?client
+      Debug.with_thread_associated ?client ?quiet
         (Context.string_of_task __context)
         (fun () ->
           (* CP-982: promote tracking debug line to info status *)
@@ -163,7 +163,7 @@ let do_dispatch ?session_id ?forward_op ?self:_ supports_async called_fn_name
 (* in the following functions, it is our responsibility to complete any tasks we create *)
 let exec_with_new_task ?http_other_config ?quiet ?subtask_of ?session_id
     ?task_in_database ?task_description ?origin task_name f =
-  exec_with_context
+  exec_with_context ?quiet
     ~__context:
       (Context.make ?http_other_config ?quiet ?subtask_of ?session_id
          ?task_in_database ?task_description ?origin task_name

ocaml/xapi/session_check.ml

@@ -57,9 +57,11 @@ let check ~intra_pool_only ~session_id ~action =
               ~self:session_id
               ~value:(Xapi_stdext_date.Date.of_float (Unix.time ()))
         with
-        | Db_exn.DBCache_NotFound (_, tblname, reference) ->
-            debug "Session check failed: missing reference; tbl = %s, ref = %s"
-              tblname reference ;
+        | Db_exn.DBCache_NotFound (_, _, reference) ->
+            info
+              "Session check failed: the client used an illegal or expired \
+               session ref '%s'"
+              reference ;
             raise
               (Api_errors.Server_error (Api_errors.session_invalid, [reference]))
         | Non_master_login_on_slave ->

ocaml/xapi/xapi_http.ml

@@ -146,8 +146,8 @@ let assert_credentials_ok realm ?(http_action = realm) ?(fn = Rbac.nofn)
     | Some session_id, _, _ ->
         let subtask_of = ref_param_of_req req "subtask_of" in
         (* Session ref has been passed in - check that it's OK *)
-        Server_helpers.exec_with_new_task ?subtask_of "xapi_http_session_check"
-          (fun __context ->
+        Server_helpers.exec_with_new_task ~quiet:true ?subtask_of
+          "xapi_http_session_check" (fun __context ->
             ( try validate_session __context session_id realm
               with _ -> raise (Http.Unauthorised realm)
             ) ;