From 2d828060d577009f7335c608c85bd0da2f62af62 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= <gregoire.henry@ocamlpro.com>
Date: Mon, 13 Mar 2017 17:40:51 +0100
Subject: [PATCH] Client: do not fail when the protocol is unknown...

---
 src/client_main.ml | 110 ++++++++++++++++++++++-----------------------
 1 file changed, 54 insertions(+), 56 deletions(-)

diff --git a/src/client_main.ml b/src/client_main.ml
index 3fa7b8aad..a3a410c51 100644
--- a/src/client_main.ml
+++ b/src/client_main.ml
@@ -9,7 +9,7 @@
 
 (* Tezos Command line interface - Main Program *)
 
-open Lwt
+open Lwt.Infix
 
 let cctxt =
   let startup =
@@ -36,61 +36,59 @@ let cctxt =
 let main () =
   Random.self_init () ;
   Sodium.Random.stir () ;
-  catch
-    (fun () ->
-       Client_config.preparse_args Sys.argv cctxt >>= fun block ->
-       Lwt.catch
-         (fun () ->
-            Client_node_rpcs.Blocks.protocol cctxt block)
-         (fun exn ->
-            cctxt.warning
-              "Error trying to acquire the protocol version from the node: %s."
-              (match exn with
-               | Failure msg -> msg
-               | exn -> Printexc.to_string exn) >>= fun () ->
-            cctxt.warning
-              "Using the default protocol version." >>= fun () ->
-            Lwt.return Client_alpha.Client_proto_main.protocol)
-       >>= fun version ->
-       let commands =
-         Client_generic_rpcs.commands @
-         Client_network.commands () @
-         Client_keys.commands () @
-         Client_protocols.commands () @
-         Client_helpers.commands () @
-         Client_commands.commands_for_version version in
-       Client_config.parse_args ~version
-         (Cli_entries.usage ~commands)
-         (Cli_entries.inline_dispatch commands)
-         Sys.argv cctxt >>= fun command ->
-       command cctxt >>= fun () ->
-       Lwt.return 0)
-    (function
-      | Arg.Help help ->
-          Format.printf "%s%!" help ;
-          Lwt.return 0
-      | Arg.Bad help ->
-          Format.eprintf "%s%!" help ;
-          Lwt.return 1
-      | Cli_entries.Command_not_found ->
-          Format.eprintf "Unkonwn command, try `-help`.\n%!" ;
-          Lwt.return 1
-      | Client_commands.Version_not_found ->
-          Format.eprintf "Unkonwn protocol version, try `list versions`.\n%!" ;
-          Lwt.return 1
-      | Cli_entries.Bad_argument (idx, _n, v) ->
-          Format.eprintf "There's a problem with argument %d, %s.\n%!" idx v ;
-          Lwt.return 1
-      | Cli_entries.Command_failed message ->
-          Format.eprintf "Command failed, %s.\n%!" message ;
-          Lwt.return 1
-      | Failure message ->
-          Format.eprintf "Fatal error: %s\n%!" message ;
-          Lwt.return 1
-      | exn ->
-          Format.printf "Fatal internal error: %s\n%!"
-            (Printexc.to_string exn) ;
-          Lwt.return 1)
+  Lwt.catch begin fun () ->
+    Client_config.preparse_args Sys.argv cctxt >>= fun block ->
+    Lwt.catch begin fun () ->
+      Client_node_rpcs.Blocks.protocol cctxt block >>= fun version ->
+      Lwt.return (Some version, Client_commands.commands_for_version version)
+    end begin fun exn ->
+      cctxt.warning
+        "Failed to acquire the protocol version from the node: %s."
+        (match exn with
+         | Failure msg -> msg
+         | exn -> Printexc.to_string exn) >>= fun () ->
+      Lwt.return (None, [])
+    end >>= fun (version, commands_for_version)  ->
+    let commands =
+      Client_generic_rpcs.commands @
+      Client_network.commands () @
+      Client_keys.commands () @
+      Client_protocols.commands () @
+      Client_helpers.commands () @
+      commands_for_version in
+    Client_config.parse_args ?version
+      (Cli_entries.usage ~commands)
+      (Cli_entries.inline_dispatch commands)
+      Sys.argv cctxt >>= fun command ->
+    command cctxt >>= fun () ->
+    Lwt.return 0
+  end begin function
+    | Arg.Help help ->
+        Format.printf "%s%!" help ;
+        Lwt.return 0
+    | Arg.Bad help ->
+        Format.eprintf "%s%!" help ;
+        Lwt.return 1
+    | Cli_entries.Command_not_found ->
+        Format.eprintf "Unkonwn command, try `-help`.\n%!" ;
+        Lwt.return 1
+    | Client_commands.Version_not_found ->
+        Format.eprintf "Unkonwn protocol version, try `list versions`.\n%!" ;
+        Lwt.return 1
+    | Cli_entries.Bad_argument (idx, _n, v) ->
+        Format.eprintf "There's a problem with argument %d, %s.\n%!" idx v ;
+        Lwt.return 1
+    | Cli_entries.Command_failed message ->
+        Format.eprintf "Command failed, %s.\n%!" message ;
+        Lwt.return 1
+    | Failure message ->
+        Format.eprintf "Fatal error: %s\n%!" message ;
+        Lwt.return 1
+    | exn ->
+        Format.printf "Fatal internal error: %s\n%!"
+          (Printexc.to_string exn) ;
+        Lwt.return 1
+  end
 
 (* Where all the user friendliness starts *)
 let () = Pervasives.exit (Lwt_main.run (main ()))