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 <rok.strnisa@citrix.com>

diff --git a/ocaml/idl/ocaml_backend/exnHelper.ml b/ocaml/idl/ocaml_backend/exnHelper.ml
index 54e3bd2a29c87cf244238654db69b412de9efaef..7c21d2117553cf2716306cbc551d6febf377f137 100644 (file)
--- 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)