Client: do not expose insecure functions (betanet)

src/bin_client/main_client.ml

@@ -14,11 +14,8 @@ let disable_disclaimer =
   | Some ("yes" | "y" | "YES" | "Y") -> true
   | _ -> false
 
-let display_warning_banner ctxt =
+let default () =
-  if disable_disclaimer then
+  if not disable_disclaimer then
-    Lwt.return ()
-  else
-    let default () =
     Format.eprintf
       "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\
       \                       This is @{<warning>NOT@} the Tezos Mainnet.@,\
@@ -26,13 +23,10 @@ let display_warning_banner ctxt =
        @,\
       \                 Use your fundraiser keys @{<warning>AT YOUR OWN RISK@}.@,\
        All transactions happening on the Betanet @{<warning>are expected to be valid in the Mainnet@}.@,\
-        \        In doubt, we recommend that you wait for the lunch of the Mainnet.@]@\n@." ;
+      \        In doubt, we recommend that you wait for the lunch of the Mainnet.@]@\n@."
-      Lwt.return_unit in
+
-    Shell_services.P2p.versions ctxt >>= function
+let zeronet () =
-    | Error _ -> default ()
+  if not disable_disclaimer then
-    | Ok versions ->
-        match String.split_on_char '_' (List.hd versions).name with
-        | "TEZOS" :: "ZERONET" :: _date :: [] ->
     Format.eprintf
       "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\
       \               This is @{<warning>NOT@} the Tezos Mainnet.@,\
@@ -41,9 +35,10 @@ let display_warning_banner ctxt =
       \    The node you are connecting to claims to be running on the@,\
       \               @{<warning>Tezos Zeronet DEVELOPMENT NETWORK@}.@,\
       \         Do @{<warning>NOT@} use your fundraiser keys on this network.@,\
-               Zeronet is a testing network, with free tokens and frequent resets.@]@\n@." ;
+       Zeronet is a testing network, with free tokens and frequent resets.@]@\n@."
-            Lwt.return_unit
+
-        | "TEZOS" :: "ALPHANET" :: _date :: [] ->
+let alphanet () =
+  if not disable_disclaimer then
     Format.eprintf
       "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\
       \               This is @{<warning>NOT@} the Tezos Mainnet.@,\
@@ -52,9 +47,10 @@ let display_warning_banner ctxt =
       \   The node you are connecting to claims to be running on the@,\
       \             @{<warning>Tezos Alphanet DEVELOPMENT NETWORK.@}@,\
       \        Do @{<warning>NOT@} use your fundraiser keys on this network.@,\
-              \        Alphanet is a testing network, with free tokens.@]@\n@." ;
+      \        Alphanet is a testing network, with free tokens.@]@\n@."
-            Lwt.return_unit
+
-        | "TEZOS" :: "BETANET" :: _date :: [] ->
+let betanet () =
+  if not disable_disclaimer then
     Format.eprintf
       "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\
       \                         This is @{<warning>NOT@} the Tezos Mainnet.@,\
@@ -65,9 +61,10 @@ let display_warning_banner ctxt =
       \    Betanet is a pre-release experimental network and comes with no warranty.@,\
       \            Use your fundraiser keys on this network @{<warning>AT YOUR OWN RISK@}.@,\
       \  All transactions happening on the Betanet @{<warning>are expected to be valid in the Mainnet@}.@,\
-              \          If in doubt, we recommend that you wait for the Mainnet lunch.@]@\n@." ;
+      \          If in doubt, we recommend that you wait for the Mainnet lunch.@]@\n@."
-            Lwt.return_unit
+
-        | "TEZOS" :: _date :: [] ->
+let sandbox () =
+  if not disable_disclaimer then
     Format.eprintf
       "@[<v 2>@{<warning>@{<title>Warning@}@}@,@,\
       \             This is @{<warning>NOT@} the Tezos Mainnet.@,\
@@ -76,9 +73,30 @@ let display_warning_banner ctxt =
       \ The node you are connecting to claims to be running in a@,\
       \                  @{<warning>Tezos TEST SANDBOX@}.@,\
       \    Do @{<warning>NOT@} use your fundraiser keys on this network.@,\
-               You should not see this message if you are not a developer.@]@\n@." ;
+       You should not see this message if you are not a developer.@]@\n@."
-            Lwt.return_unit
+
-        | _ -> default ()
+let check_version ctxt =
+  Shell_services.P2p.versions ctxt >>= function
+  | Error _ ->
+      default () ;
+      Lwt.return_none
+  | Ok versions ->
+      match String.split_on_char '_' (List.hd versions).name with
+      | "TEZOS" :: "ZERONET" :: _date :: [] ->
+          zeronet () ;
+          Lwt.return_some `Zeronet
+      | "TEZOS" :: "ALPHANET" :: _date :: [] ->
+          alphanet () ;
+          Lwt.return_some `Alphanet
+      | "TEZOS" :: "BETANET" :: _date :: [] ->
+          betanet () ;
+          Lwt.return_some `Betanet
+      | "TEZOS" :: _date :: [] ->
+          sandbox () ;
+          Lwt.return_some `Sandbox
+      | _ ->
+          default () ;
+          Lwt.return_none
 
 let get_commands_for_version ctxt block protocol =
   Shell_services.Blocks.protocols ctxt ~block () >>= function
@@ -111,14 +129,14 @@ let get_commands_for_version ctxt block protocol =
     end
 
 let select_commands ctxt { block ; protocol } =
-  display_warning_banner ctxt >>= fun () ->
+  check_version ctxt >>= fun version ->
   get_commands_for_version ctxt block protocol >>|? fun (_, commands_for_version)  ->
   Client_rpc_commands.commands @
   List.map
     (Clic.map_command
        (fun (o : Client_context.full) -> (o :> Client_context.io_wallet)))
     (Tezos_signer_backends.Ledger.commands () @
-     Client_keys_commands.commands ()) @
+     Client_keys_commands.commands version) @
   Client_helpers_commands.commands () @
   commands_for_version
 

src/bin_signer/main_signer.ml

@@ -67,7 +67,7 @@ let magic_bytes_arg =
                      is expected, separated by commas."))
 
 let commands base_dir require_auth =
-  Client_keys_commands.commands () @
+  Client_keys_commands.commands None @
   Tezos_signer_backends.Ledger.commands () @
   [ command ~group
       ~desc: "Launch a signer daemon over a TCP socket."

src/lib_client_commands/client_keys_commands.ml

@@ -13,17 +13,6 @@ let group =
   { Clic.name = "keys" ;
     title = "Commands for managing the wallet of cryptographic keys" }
 
-let encrypted_switch () =
-  if List.exists
-      (fun (scheme, _) ->
-         scheme = Tezos_signer_backends.Unencrypted.scheme)
-      (Client_keys.registered_signers ()) then
-    Clic.switch
-      ~long:"encrypted"
-      ~doc:("Encrypt the key on-disk") ()
-  else
-    Clic.constant true
-
 let sig_algo_arg =
   Clic.default_arg
     ~doc:"use custom signature algorithm"
@@ -156,8 +145,18 @@ let rec input_fundraiser_params (cctxt : #Client_context.io_wallet) =
       | true -> return sk
       | false -> input_fundraiser_params cctxt
 
-let commands () : Client_context.io_wallet Clic.command list =
+let commands version : Client_context.io_wallet Clic.command list =
   let open Clic in
+  let encrypted_switch () =
+    if List.exists
+        (fun (scheme, _) ->
+           scheme = Tezos_signer_backends.Unencrypted.scheme)
+        (Client_keys.registered_signers ()) then
+      Clic.switch
+        ~long:"encrypted"
+        ~doc:("Encrypt the key on-disk") ()
+    else
+      Clic.constant true in
   let show_private_switch =
     switch
       ~long:"show-secret"
@@ -188,6 +187,20 @@ let commands () : Client_context.io_wallet Clic.command list =
                 n S.title Format.pp_print_text S.description)
            signers >>= return) ;
 
+    begin match version with
+      | Some `Betanet ->
+          command ~group ~desc: "Generate a pair of keys."
+            (args2 (Secret_key.force_switch ()) sig_algo_arg)
+            (prefixes [ "gen" ; "keys" ]
+             @@ Secret_key.fresh_alias_param
+             @@ stop)
+            (fun (force, algo) name (cctxt : Client_context.io_wallet) ->
+               Secret_key.of_fresh cctxt force name >>=? fun name ->
+               let (pkh, pk, sk) = Signature.generate_key ~algo () in
+               let pk_uri = Tezos_signer_backends.Unencrypted.make_pk pk in
+               Tezos_signer_backends.Encrypted.encrypt cctxt sk >>=? fun sk_uri ->
+               register_key cctxt ~force (pkh, pk_uri, sk_uri) name)
+      | _ ->
           command ~group ~desc: "Generate a pair of keys."
             (args3 (Secret_key.force_switch ()) sig_algo_arg (encrypted_switch ()))
             (prefixes [ "gen" ; "keys" ]
@@ -203,8 +216,27 @@ let commands () : Client_context.io_wallet Clic.command list =
                  else
                    return (Tezos_signer_backends.Unencrypted.make_sk sk)
                end >>=? fun sk_uri ->
-         register_key cctxt ~force (pkh, pk_uri, sk_uri) name) ;
+               register_key cctxt ~force (pkh, pk_uri, sk_uri) name)
+    end ;
 
+    begin match version with
+      | Some `Betanet ->
+          command ~group ~desc: "Generate keys including the given string."
+            (args2
+               (switch
+                  ~long:"prefix"
+                  ~short:'P'
+                  ~doc:"the key must begin with tz1[word]"
+                  ())
+               (force_switch ()))
+            (prefixes [ "gen" ; "vanity" ; "keys" ]
+             @@ Public_key_hash.fresh_alias_param
+             @@ prefix "matching"
+             @@ (seq_of_param @@ string ~name:"words" ~desc:"string key must contain one of these words"))
+            (fun (prefix, force) name containing (cctxt : Client_context.io_wallet) ->
+               Public_key_hash.of_fresh cctxt force name >>=? fun name ->
+               gen_keys_containing ~encrypted:true ~force ~prefix ~containing ~name cctxt)
+      | _ ->
           command ~group ~desc: "Generate keys including the given string."
             (args3
                (switch
@@ -220,7 +252,8 @@ let commands () : Client_context.io_wallet Clic.command list =
              @@ (seq_of_param @@ string ~name:"words" ~desc:"string key must contain one of these words"))
             (fun (prefix, force, encrypted) name containing (cctxt : Client_context.io_wallet) ->
                Public_key_hash.of_fresh cctxt force name >>=? fun name ->
-         gen_keys_containing ~encrypted ~force ~prefix ~containing ~name cctxt) ;
+               gen_keys_containing ~encrypted ~force ~prefix ~containing ~name cctxt)
+    end ;
 
     command ~group ~desc: "Add a secret key to the wallet."
       (args1 (Secret_key.force_switch ()))

src/lib_client_commands/client_keys_commands.mli

@@ -7,6 +7,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-val commands: unit -> Client_context.io_wallet Clic.command list
+val commands:
-
+  [`Zeronet | `Alphanet | `Betanet | `Sandbox] option ->
-val encrypted_switch: unit -> (bool, 'a) Clic.arg
+  Client_context.io_wallet Clic.command list