diff --git a/ocaml/libs/log/debug.ml b/ocaml/libs/log/debug.ml index e1999a17337..b4a5721b9e3 100644 --- a/ocaml/libs/log/debug.ml +++ b/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 = diff --git a/ocaml/libs/log/debug.mli b/ocaml/libs/log/debug.mli index 78b17cd5511..f584c94cc38 100644 --- a/ocaml/libs/log/debug.mli +++ b/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} *) diff --git a/ocaml/xapi/server_helpers.ml b/ocaml/xapi/server_helpers.ml index 9324fddb71b..890ad9abbba 100644 --- a/ocaml/xapi/server_helpers.ml +++ b/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 diff --git a/ocaml/xapi/session_check.ml b/ocaml/xapi/session_check.ml index 16fef1ac30b..27812fc5244 100644 --- a/ocaml/xapi/session_check.ml +++ b/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 -> diff --git a/ocaml/xapi/xapi_http.ml b/ocaml/xapi/xapi_http.ml index 87a7ad575a5..1750a9e4317 100644 --- a/ocaml/xapi/xapi_http.ml +++ b/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) ) ;