Shell: properly handle Unix_error while validating blocks

src/lib_shell/block_validator.ml

@@ -153,9 +153,7 @@ let on_request
                   block ;
                 notify_new_block block ;
                 return (Ok (Some block))
-            (* TODO catch other temporary error (e.g. system errors)
+            | Error [ Canceled | Unavailable_protocol _ | System_error _ ] as err ->
-               and do not 'commit' them on disk... *)
-            | Error [Canceled | Unavailable_protocol _] as err ->
                 (* FIXME: Canceled can escape. Canceled is not registered. BOOM! *)
                 return err
             | Error errors ->

src/lib_shell/bootstrap_pipeline.ml

@@ -268,6 +268,7 @@ let rec validation_worker_loop pipeline =
       Lwt.return_unit
   | Error ([ Block_validator_errors.Invalid_block _
            | Block_validator_errors.Unavailable_protocol _
+           | Block_validator_errors.System_error _
            | Timeout] as err ) ->
       (* Propagate the error to the peer validator. *)
       pipeline.errors <- pipeline.errors @ err ;

src/lib_shell/peer_validator.ml

@@ -299,6 +299,9 @@ let on_error w r st errs =
       Worker.trigger_shutdown w ;
       Worker.record_event w (Event.Request (r, st, Some errs)) ;
       Lwt.return (Error errs)
+  | [Block_validator_errors.System_error _ ] as errs ->
+      Worker.record_event w (Event.Request (r, st, Some errs)) ;
+      return_unit
   | [Block_validator_errors.Unavailable_protocol { protocol } ] -> begin
       Block_validator.fetch_and_compile_protocol
         pv.parameters.block_validator

src/lib_shell_services/block_validator_errors.ml

@@ -49,6 +49,91 @@ type block_error =
                         allowed_pass: int list }
   | Cannot_parse_block_header
 
+let errno : Unix.error Data_encoding.t =
+  let open Data_encoding in
+  union [
+    case
+      ~title:"unknown_unix_error"
+      (Tag 0) int8
+      (function Unix.EUNKNOWNERR i -> Some i | _ -> None)
+      (fun i -> EUNKNOWNERR i) ;
+    case
+      ~title:"unix_error"
+      (Tag 1)
+      (string_enum
+         Unix.[
+           "2big", E2BIG ;
+           "acces", EACCES ;
+           "again", EAGAIN ;
+           "badf", EBADF ;
+           "busy", EBUSY ;
+           "child", ECHILD ;
+           "deadlk", EDEADLK ;
+           "dom", EDOM ;
+           "exist", EEXIST ;
+           "fault", EFAULT ;
+           "fbig", EFBIG ;
+           "intr", EINTR ;
+           "inval", EINVAL ;
+           "io", EIO ;
+           "isdir", EISDIR ;
+           "mfile", EMFILE ;
+           "mlink", EMLINK ;
+           "nametoolong", ENAMETOOLONG ;
+           "nfile", ENFILE ;
+           "nodev", ENODEV ;
+           "noent", ENOENT ;
+           "noexec", ENOEXEC ;
+           "nolck", ENOLCK ;
+           "nomem", ENOMEM ;
+           "nospc", ENOSPC ;
+           "nosys", ENOSYS ;
+           "notdir", ENOTDIR ;
+           "notempty", ENOTEMPTY ;
+           "notty", ENOTTY ;
+           "nxio", ENXIO ;
+           "perm", EPERM ;
+           "pipe", EPIPE ;
+           "range", ERANGE ;
+           "rofs", EROFS ;
+           "spipe", ESPIPE ;
+           "srch", ESRCH ;
+           "xdev", EXDEV ;
+           "wouldblock", EWOULDBLOCK ;
+           "inprogress", EINPROGRESS ;
+           "already", EALREADY ;
+           "notsock", ENOTSOCK ;
+           "destaddrreq", EDESTADDRREQ ;
+           "msgsize", EMSGSIZE ;
+           "prototype", EPROTOTYPE ;
+           "noprotoopt", ENOPROTOOPT ;
+           "protonosupport", EPROTONOSUPPORT ;
+           "socktnosupport", ESOCKTNOSUPPORT ;
+           "opnotsupp", EOPNOTSUPP ;
+           "pfnosupport", EPFNOSUPPORT ;
+           "afnosupport", EAFNOSUPPORT ;
+           "addrinuse", EADDRINUSE ;
+           "addrnotavail", EADDRNOTAVAIL ;
+           "netdown", ENETDOWN ;
+           "netunreach", ENETUNREACH ;
+           "netreset", ENETRESET ;
+           "connaborted", ECONNABORTED ;
+           "connreset", ECONNRESET ;
+           "nobufs", ENOBUFS ;
+           "isconn", EISCONN ;
+           "notconn", ENOTCONN ;
+           "shutdown", ESHUTDOWN ;
+           "toomanyrefs", ETOOMANYREFS ;
+           "timedout", ETIMEDOUT ;
+           "connrefused", ECONNREFUSED ;
+           "hostdown", EHOSTDOWN ;
+           "hostunreach", EHOSTUNREACH ;
+           "loop", ELOOP ;
+           "overflow", EOVERFLOW ])
+      (fun x -> Some x)
+      (fun x -> x)
+  ]
+
 let block_error_encoding =
   let open Data_encoding in
   union
@@ -256,6 +341,9 @@ type error +=
         expected: Operation_list_list_hash.t ;
         found: Operation_list_list_hash.t }
   | Failed_to_checkout_context of Context_hash.t
+  | System_error of { errno: Unix.error ;
+                      fn: string ;
+                      msg: string }
 
 let () =
   Error_monad.register_error_kind
@@ -335,6 +423,23 @@ let () =
     (function
       | Failed_to_checkout_context h -> Some h
       | _ -> None)
-    (fun h -> Failed_to_checkout_context h)
+    (fun h -> Failed_to_checkout_context h) ;
+  Error_monad.register_error_kind
+    `Temporary
+    ~id:"Validator_process.system_error_while_validating"
+    ~title: "Failed to validate block because of a system error"
+    ~description: "The validator failed because of a system error"
+    ~pp:(fun ppf (errno, fn, msg) ->
+        Format.fprintf ppf
+          "System error while validating a block (in function %s(%s)):@ %s"
+          fn msg (Unix.error_message errno))
+    Data_encoding.(obj3
+                     (req "errno" errno)
+                     (req "function" string)
+                     (req "msg" string))
+    (function
+      | System_error { errno ; fn ; msg } -> Some (errno, fn, msg)
+      | _ -> None)
+    (fun (errno, fn, msg) -> System_error { errno ; fn ; msg })
 
 let invalid_block block error = Invalid_block { block ; error }

src/lib_shell_services/block_validator_errors.mli

@@ -59,5 +59,8 @@ type error +=
         expected: Operation_list_list_hash.t ;
         found: Operation_list_list_hash.t }
   | Failed_to_checkout_context of Context_hash.t
+  | System_error of { errno: Unix.error ;
+                      fn: string ;
+                      msg: string }
 
 val invalid_block : Block_hash.t -> block_error -> error

src/lib_validation/block_validation.ml

@@ -276,4 +276,7 @@ let apply
     ~predecessor_block_header
     ~predecessor_context
     ~block_header
-    operations
+    operations >>= function
+  | Error (Exn (Unix.Unix_error (errno, fn, msg)) :: _) ->
+      fail (System_error { errno ; fn ; msg })
+  | (Ok _ | Error _) as res -> Lwt.return res