# HG changeset patch # User Rok Strnisa # Date 1283858981 -3600 # Node ID f227aab14dc6c49e21c7fc6aabd6c2fd7ff7d695 # Parent fc32de1e23c2ea0e58f8ef94788c75062aff77e4 CA-26863: correct error message when pool connection fails --- FIXED. I only added these two lines: | Stunnel.Stunnel_error msg -> internal_error, [ "Connection failed: " ^ (String.lowercase msg) ^ "." ] The rest is fixing whitespace. Note that calling "lowercase" on "msg" does not lose information, since all error messages in Stunnel are fixed strings. It makes the output nicer. Signed-off-by: Rok Strnisa diff --git a/ocaml/idl/ocaml_backend/exnHelper.ml b/ocaml/idl/ocaml_backend/exnHelper.ml --- a/ocaml/idl/ocaml_backend/exnHelper.ml +++ b/ocaml/idl/ocaml_backend/exnHelper.ml @@ -18,53 +18,54 @@ open XMLRPC open Api_errors open Printf +open Stringext module D = Debug.Debugger(struct let name="backtrace" end) open D let error_of_exn e = - log_backtrace (); - match e with - | XMLRPC.RunTimeTypeError(expected, found) -> - xmlrpc_unmarshal_failure, [ expected; Xml.to_string_fmt found ] + log_backtrace (); + match e with + | Stunnel.Stunnel_error msg -> + internal_error, [ "Connection failed: " ^ (String.lowercase msg) ^ "." ] + | XMLRPC.RunTimeTypeError(expected, found) -> + xmlrpc_unmarshal_failure, [ expected; Xml.to_string_fmt found ] + | Db_exn.DBCache_NotFound ("missing reference", tblname, reference) -> + (* whenever a reference has been destroyed *) + handle_invalid, [tblname; reference ] + | Db_cache.Too_many_values(tbl, objref, uuid) -> + (* Very bad: database has duplicate references or UUIDs *) + internal_error, [ sprintf "duplicate objects in database: tbl='%s'; object_ref='%s'; uuid='%s'" tbl objref uuid ] + | Db_action_helper.Db_set_or_map_parse_fail s -> + internal_error, [ sprintf "db set/map failure: %s" s ] + | Db_exn.DBCache_NotFound (reason,p1,p2) -> + begin + match reason with + "missing row" -> handle_invalid, [p1; p2] + | s -> internal_error, [reason; p1; p2] + end + | Db_exn.Duplicate_key (tbl,fld,uuid,key) -> + map_duplicate_key, [ tbl; fld; uuid; key ] + | Db_cache.Read_missing_uuid (tbl,ref,uuid) -> + uuid_invalid, [ tbl; uuid ] + | Db_actions.DM_to_String.StringEnumTypeError s + | Db_actions.DM_to_String.DateTimeError s + | Db_actions.String_to_DM.StringEnumTypeError s -> + invalid_value, [ s ] - | Db_exn.DBCache_NotFound ("missing reference", tblname, reference) -> - (* whenever a reference has been destroyed *) - handle_invalid, [tblname; reference ] - | Db_cache.Too_many_values(tbl, objref, uuid) -> - (* Very bad: database has duplicate references or UUIDs *) - internal_error, [ sprintf "duplicate objects in database: tbl='%s'; object_ref='%s'; uuid='%s'" tbl objref uuid ] - | Db_action_helper.Db_set_or_map_parse_fail s -> - internal_error, [ sprintf "db set/map failure: %s" s ] - | Db_exn.DBCache_NotFound (reason,p1,p2) -> - begin - match reason with - "missing row" -> handle_invalid, [p1; p2] - | s -> internal_error, [reason; p1; p2] - end - | Db_exn.Duplicate_key (tbl,fld,uuid,key) -> - map_duplicate_key, [ tbl; fld; uuid; key ] - | Db_cache.Read_missing_uuid (tbl,ref,uuid) -> - uuid_invalid, [ tbl; uuid ] - - | Db_actions.DM_to_String.StringEnumTypeError s - | Db_actions.DM_to_String.DateTimeError s - | Db_actions.String_to_DM.StringEnumTypeError s -> - invalid_value, [ s ] - -(* These are the two catch-all patterns. If ever an Errors.Server_error exception *) -(* is raised, this is assumed to be an API error, and passed straight on. Any other *) -(* exception at this point is regarded as an 'internal error', and returned as such *) + (* These are the two catch-all patterns. If ever an Errors.Server_error exception *) + (* is raised, this is assumed to be an API error, and passed straight on. Any other *) + (* exception at this point is regarded as an 'internal error', and returned as such *) - | Api_errors.Server_error (e,l) -> - e,l - | Forkhelpers.Spawn_internal_error(stderr, stdout, Unix.WEXITED n) as e -> - internal_error, [ Printf.sprintf "Subprocess exitted with unexpected code %d; stdout = [ %s ]; stderr = [ %s ]" n stdout stderr ] - | Invalid_argument x -> - internal_error, [ Printf.sprintf "Invalid argument: %s" x ] - | e -> - internal_error, [ Printexc.to_string e ] + | Api_errors.Server_error (e,l) -> + e,l + | Forkhelpers.Spawn_internal_error(stderr, stdout, Unix.WEXITED n) as e -> + internal_error, [ Printf.sprintf "Subprocess exitted with unexpected code %d; stdout = [ %s ]; stderr = [ %s ]" n stdout stderr ] + | Invalid_argument x -> + internal_error, [ Printf.sprintf "Invalid argument: %s" x ] + | e -> + internal_error, [ Printexc.to_string e ] -let string_of_exn exn = - let e, l = error_of_exn exn in - Printf.sprintf "%s: [ %s ]" e (String.concat "; " l) +let string_of_exn exn = + let e, l = error_of_exn exn in + Printf.sprintf "%s: [ %s ]" e (String.concat "; " l)