From 272066ab047db1d4700a79bbb39e3878599b815c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Gr=C3=A9goire=20Henry?= Date: Sat, 26 May 2018 11:12:36 +0200 Subject: [PATCH] Client: Use `MBytes.t` for password This prepares a future usage of `mlock`. --- src/lib_client_base/client_context.ml | 8 ++-- src/lib_client_base/client_context.mli | 4 +- .../client_context_unix.ml | 8 ++-- .../client_signer_encrypted.ml | 40 +++++++++---------- .../lib_baking/test/proto_alpha_helpers.ml | 8 ++-- 5 files changed, 33 insertions(+), 35 deletions(-) diff --git a/src/lib_client_base/client_context.ml b/src/lib_client_base/client_context.ml index e7613177b..8fb20807c 100644 --- a/src/lib_client_base/client_context.ml +++ b/src/lib_client_base/client_context.ml @@ -19,8 +19,8 @@ class type printer = object end class type prompter = object - method prompt : ('a, string) lwt_format -> 'a - method prompt_password : ('a, string) lwt_format -> 'a + method prompt : ('a, string tzresult) lwt_format -> 'a + method prompt_password : ('a, MBytes.t tzresult) lwt_format -> 'a end class type io = object @@ -97,6 +97,6 @@ class proxy_context (obj : full) = object method message : type a. (a, unit) lwt_format -> a = obj#message method warning : type a. (a, unit) lwt_format -> a = obj#warning method write : type a. string -> a -> a Data_encoding.encoding -> unit tzresult Lwt.t = obj#write - method prompt : type a. (a, string) lwt_format -> a = obj#prompt - method prompt_password : type a. (a, string) lwt_format -> a = obj#prompt_password + method prompt : type a. (a, string tzresult) lwt_format -> a = obj#prompt + method prompt_password : type a. (a, MBytes.t tzresult) lwt_format -> a = obj#prompt_password end diff --git a/src/lib_client_base/client_context.mli b/src/lib_client_base/client_context.mli index dec91459f..6f6082503 100644 --- a/src/lib_client_base/client_context.mli +++ b/src/lib_client_base/client_context.mli @@ -19,8 +19,8 @@ class type printer = object end class type prompter = object - method prompt : ('a, string) lwt_format -> 'a - method prompt_password : ('a, string) lwt_format -> 'a + method prompt : ('a, string tzresult) lwt_format -> 'a + method prompt_password : ('a, MBytes.t tzresult) lwt_format -> 'a end class type io = object diff --git a/src/lib_client_base_unix/client_context_unix.ml b/src/lib_client_base_unix/client_context_unix.ml index e8af897c4..6364d2b2b 100644 --- a/src/lib_client_base_unix/client_context_unix.ml +++ b/src/lib_client_base_unix/client_context_unix.ml @@ -44,18 +44,18 @@ class unix_wallet ~base_dir : wallet = object (self) end class unix_prompter = object - method prompt : type a. (a, string) lwt_format -> a = + method prompt : type a. (a, string tzresult) lwt_format -> a = Format.kasprintf begin fun msg -> print_string msg ; let line = read_line () in - Lwt.return line + return line end - method prompt_password : type a. (a, string) lwt_format -> a = + method prompt_password : type a. (a, MBytes.t tzresult) lwt_format -> a = Format.kasprintf begin fun msg -> print_string msg ; let line = Lwt_utils_unix.getpass () in - Lwt.return line + return (MBytes.of_string line) end end diff --git a/src/lib_client_base_unix/client_signer_encrypted.ml b/src/lib_client_base_unix/client_signer_encrypted.ml index 9d3ebccbb..9d2079ff4 100644 --- a/src/lib_client_base_unix/client_signer_encrypted.ml +++ b/src/lib_client_base_unix/client_signer_encrypted.ml @@ -60,21 +60,20 @@ module Encrypted_signer : SIGNER = struct to_bigarray salt, to_bigarray skenc let rec passwd_ask_loop (cctxt : #Client_context.io_wallet) ~name ~salt ~skenc = - cctxt#prompt_password "Enter password for encrypted key %s: " name >>= fun password -> - let password = MBytes.of_string password in + cctxt#prompt_password "Enter password for encrypted key %s: " name >>=? fun password -> let key = pbkdf ~salt ~password in let key = Crypto_box.Secretbox.unsafe_of_bytes key in match Crypto_box.Secretbox.box_open key skenc nonce with | None -> passwd_ask_loop cctxt ~name ~salt ~skenc | Some decrypted_sk -> - Lwt.return (password, (Data_encoding.Binary.of_bytes_exn - Signature.Secret_key.encoding - decrypted_sk)) + return (password, (Data_encoding.Binary.of_bytes_exn + Signature.Secret_key.encoding + decrypted_sk)) let ask_all_passwords (cctxt : #Client_context.io_wallet) sks = - Lwt_list.fold_left_s begin fun a (name, skloc) -> + fold_left_s begin fun a (name, skloc) -> if Secret_key_locator.scheme skloc <> scheme then - Lwt.return a + return a else match Secret_key_locator.location skloc with |location :: _ -> begin @@ -86,12 +85,12 @@ module Encrypted_signer : SIGNER = struct | Some sk -> Hashtbl.replace decrypted_sks location (Data_encoding.Binary.of_bytes_exn Signature.Secret_key.encoding sk); - Lwt.return a + return a | None -> passwd_ask_loop - cctxt ~name ~salt ~skenc >>= fun (passwd, decrypted_sk) -> + cctxt ~name ~salt ~skenc >>=? fun (passwd, decrypted_sk) -> Hashtbl.replace decrypted_sks location decrypted_sk ; - Lwt.return (passwd :: a) + return (passwd :: a) end |_ -> Lwt.fail Exit end [] sks @@ -104,15 +103,14 @@ module Encrypted_signer : SIGNER = struct (fun _ -> failwith "Corrupted secret key database. Aborting.") let input_new_passphrase (cctxt : #Client_context.io_wallet) = - cctxt#prompt_password "Enter passphrase to encrypt your key: " >>= fun password -> - cctxt#prompt_password "Confirm passphrase: " >>= fun confirm -> + cctxt#prompt_password "Enter passphrase to encrypt your key: " >>=? fun password -> + cctxt#prompt_password "Confirm passphrase: " >>=? fun confirm -> if password <> confirm then failwith "Passphrases do not match." else return password let encrypt_sk cctxt sk = input_new_passphrase cctxt >>=? fun password -> - let password = MBytes.of_string password in let salt = Rand.generate salt_len in let key = Crypto_box.Secretbox.unsafe_of_bytes (pbkdf ~password ~salt) in let msg = Data_encoding.Binary.to_bytes_exn Signature.Secret_key.encoding sk in @@ -124,7 +122,7 @@ module Encrypted_signer : SIGNER = struct let rec get_boolean_answer (cctxt : #Client_context.io_wallet) ~default ~msg = let prompt = if default then "(Y/n/q)" else "(y/N/q)" in - cctxt#prompt "%s %s: " msg prompt >>= fun gen -> + cctxt#prompt "%s %s: " msg prompt >>=? fun gen -> match default, String.lowercase_ascii gen with | default, "" -> return default | _, "y" -> return true @@ -133,21 +131,21 @@ module Encrypted_signer : SIGNER = struct | _ -> get_boolean_answer cctxt ~msg ~default let rec sk_of_mnemonic (cctxt : #Client_context.io_wallet) = - cctxt#prompt "Enter the e-mail used for the paper wallet: " >>= fun email -> + cctxt#prompt "Enter the e-mail used for the paper wallet: " >>=? fun email -> let rec loop_words acc i = - if i > 14 then Lwt.return (List.rev acc) else - cctxt#prompt_password "Enter word %d: " i >>= fun word -> - match Bip39.index_of_word word with + if i > 14 then return (List.rev acc) else + cctxt#prompt_password "Enter word %d: " i >>=? fun word -> + match Bip39.index_of_word (MBytes.to_string word) with | None -> loop_words acc i | Some wordidx -> loop_words (wordidx :: acc) (succ i) in - loop_words [] 0 >>= fun words -> + loop_words [] 0 >>=? fun words -> match Bip39.of_indices words with | None -> assert false | Some t -> cctxt#prompt_password - "Enter the password used for the paper wallet: " >>= fun password -> + "Enter the password used for the paper wallet: " >>=? fun password -> (* TODO: unicode normalization (NFKD)... *) - let sk = Bip39.to_seed ~passphrase:(email ^ password) t in + let sk = Bip39.to_seed ~passphrase:(email ^ MBytes.to_string password) t in let sk = Cstruct.(to_bigarray (sub sk 0 32)) in let sk : Signature.Secret_key.t = Ed25519 diff --git a/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml b/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml index 00feb6cc9..d2642d592 100644 --- a/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml +++ b/src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml @@ -38,10 +38,10 @@ let no_write_context ?(block = `Head 0) config : #Client_context.full = object a Data_encoding.encoding -> unit Error_monad.tzresult Lwt.t = fun _ _ _ -> return () method block = block - method prompt : type a. (a, string) Client_context.lwt_format -> a = - Format.kasprintf (fun _ -> Lwt.return "") - method prompt_password : type a. (a, string) Client_context.lwt_format -> a = - Format.kasprintf (fun _ -> Lwt.return "") + method prompt : type a. (a, string tzresult) Client_context.lwt_format -> a = + Format.kasprintf (fun _ -> return "") + method prompt_password : type a. (a, MBytes.t tzresult) Client_context.lwt_format -> a = + Format.kasprintf (fun _ -> return (MBytes.of_string "")) end let sandbox_parameters =