balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Client: Use MBytes.t for password

Browse Source 
This prepares a future usage of `mlock`.
This commit is contained in:
Grégoire Henry 2018-05-26 11:12:36 +02:00
parent ad9f4c2814
commit 272066ab04
5 changed files with 33 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
src/lib_client_base/client_context.ml
View File

@ -19,8 +19,8 @@ class type printer = object
end end
class type prompter = object class type prompter = object
method prompt : ('a, string) lwt_format -> 'a method prompt : ('a, string tzresult) lwt_format -> 'a
method prompt_password : ('a, string) lwt_format -> 'a method prompt_password : ('a, MBytes.t tzresult) lwt_format -> 'a
end end
class type io = object 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 message : type a. (a, unit) lwt_format -> a = obj#message
method warning : type a. (a, unit) lwt_format -> a = obj#warning 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 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 : type a. (a, string tzresult) lwt_format -> a = obj#prompt
method prompt_password : type a. (a, string) lwt_format -> a = obj#prompt_password method prompt_password : type a. (a, MBytes.t tzresult) lwt_format -> a = obj#prompt_password
end end

4
src/lib_client_base/client_context.mli
View File

@ -19,8 +19,8 @@ class type printer = object
end end
class type prompter = object class type prompter = object
method prompt : ('a, string) lwt_format -> 'a method prompt : ('a, string tzresult) lwt_format -> 'a
method prompt_password : ('a, string) lwt_format -> 'a method prompt_password : ('a, MBytes.t tzresult) lwt_format -> 'a
end end
class type io = object class type io = object

8
src/lib_client_base_unix/client_context_unix.ml
View File

@ -44,18 +44,18 @@ class unix_wallet ~base_dir : wallet = object (self)
end end
class unix_prompter = object 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 -> Format.kasprintf begin fun msg ->
print_string msg ; print_string msg ;
let line = read_line () in let line = read_line () in
Lwt.return line return line
end 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 -> Format.kasprintf begin fun msg ->
print_string msg ; print_string msg ;
let line = Lwt_utils_unix.getpass () in let line = Lwt_utils_unix.getpass () in
Lwt.return line return (MBytes.of_string line)
end end
end end

36
src/lib_client_base_unix/client_signer_encrypted.ml
View File

@ -60,21 +60,20 @@ module Encrypted_signer : SIGNER = struct
to_bigarray salt, to_bigarray skenc to_bigarray salt, to_bigarray skenc
let rec passwd_ask_loop (cctxt : #Client_context.io_wallet) ~name ~salt ~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 -> cctxt#prompt_password "Enter password for encrypted key %s: " name >>=? fun password ->
let password = MBytes.of_string password in
let key = pbkdf ~salt ~password in let key = pbkdf ~salt ~password in
let key = Crypto_box.Secretbox.unsafe_of_bytes key in let key = Crypto_box.Secretbox.unsafe_of_bytes key in
match Crypto_box.Secretbox.box_open key skenc nonce with match Crypto_box.Secretbox.box_open key skenc nonce with
| None -> passwd_ask_loop cctxt ~name ~salt ~skenc | None -> passwd_ask_loop cctxt ~name ~salt ~skenc
| Some decrypted_sk -> | Some decrypted_sk ->
Lwt.return (password, (Data_encoding.Binary.of_bytes_exn return (password, (Data_encoding.Binary.of_bytes_exn
Signature.Secret_key.encoding Signature.Secret_key.encoding
decrypted_sk)) decrypted_sk))
let ask_all_passwords (cctxt : #Client_context.io_wallet) sks = 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 if Secret_key_locator.scheme skloc <> scheme then
Lwt.return a return a
else else
match Secret_key_locator.location skloc with match Secret_key_locator.location skloc with
|location :: _ -> begin |location :: _ -> begin
@ -86,12 +85,12 @@ module Encrypted_signer : SIGNER = struct
| Some sk -> | Some sk ->
Hashtbl.replace decrypted_sks location Hashtbl.replace decrypted_sks location
(Data_encoding.Binary.of_bytes_exn Signature.Secret_key.encoding sk); (Data_encoding.Binary.of_bytes_exn Signature.Secret_key.encoding sk);
Lwt.return a return a
| None -> | None ->
passwd_ask_loop 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 ; Hashtbl.replace decrypted_sks location decrypted_sk ;
Lwt.return (passwd :: a) return (passwd :: a)
end end
|_ -> Lwt.fail Exit |_ -> Lwt.fail Exit
end [] sks end [] sks
@ -104,15 +103,14 @@ module Encrypted_signer : SIGNER = struct
(fun _ -> failwith "Corrupted secret key database. Aborting.") (fun _ -> failwith "Corrupted secret key database. Aborting.")
let input_new_passphrase (cctxt : #Client_context.io_wallet) = let input_new_passphrase (cctxt : #Client_context.io_wallet) =
cctxt#prompt_password "Enter passphrase to encrypt your key: " >>= fun password -> cctxt#prompt_password "Enter passphrase to encrypt your key: " >>=? fun password ->
cctxt#prompt_password "Confirm passphrase: " >>= fun confirm -> cctxt#prompt_password "Confirm passphrase: " >>=? fun confirm ->
if password <> confirm then if password <> confirm then
failwith "Passphrases do not match." failwith "Passphrases do not match."
else return password else return password
let encrypt_sk cctxt sk = let encrypt_sk cctxt sk =
input_new_passphrase cctxt >>=? fun password -> input_new_passphrase cctxt >>=? fun password ->
let password = MBytes.of_string password in
let salt = Rand.generate salt_len in let salt = Rand.generate salt_len in
let key = Crypto_box.Secretbox.unsafe_of_bytes (pbkdf ~password ~salt) 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 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 rec get_boolean_answer (cctxt : #Client_context.io_wallet) ~default ~msg =
let prompt = if default then "(Y/n/q)" else "(y/N/q)" in 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 match default, String.lowercase_ascii gen with
| default, "" -> return default | default, "" -> return default
| _, "y" -> return true | _, "y" -> return true
@ -133,21 +131,21 @@ module Encrypted_signer : SIGNER = struct
| _ -> get_boolean_answer cctxt ~msg ~default | _ -> get_boolean_answer cctxt ~msg ~default
let rec sk_of_mnemonic (cctxt : #Client_context.io_wallet) = 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 = let rec loop_words acc i =
if i > 14 then Lwt.return (List.rev acc) else if i > 14 then return (List.rev acc) else
cctxt#prompt_password "Enter word %d: " i >>= fun word -> cctxt#prompt_password "Enter word %d: " i >>=? fun word ->
match Bip39.index_of_word word with match Bip39.index_of_word (MBytes.to_string word) with
| None -> loop_words acc i | None -> loop_words acc i
| Some wordidx -> loop_words (wordidx :: acc) (succ i) in | 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 match Bip39.of_indices words with
| None -> assert false | None -> assert false
| Some t -> | Some t ->
cctxt#prompt_password 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)... *) (* 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 = Cstruct.(to_bigarray (sub sk 0 32)) in
let sk : Signature.Secret_key.t = let sk : Signature.Secret_key.t =
Ed25519 Ed25519

8
src/proto_alpha/lib_baking/test/proto_alpha_helpers.ml
View File

@ -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 = a Data_encoding.encoding -> unit Error_monad.tzresult Lwt.t =
fun _ _ _ -> return () fun _ _ _ -> return ()
method block = block method block = block
method prompt : type a. (a, string) Client_context.lwt_format -> a = method prompt : type a. (a, string tzresult) Client_context.lwt_format -> a =
Format.kasprintf (fun _ -> Lwt.return "") Format.kasprintf (fun _ -> return "")
method prompt_password : type a. (a, string) Client_context.lwt_format -> a = method prompt_password : type a. (a, MBytes.t tzresult) Client_context.lwt_format -> a =
Format.kasprintf (fun _ -> Lwt.return "") Format.kasprintf (fun _ -> return (MBytes.of_string ""))
end end
let sandbox_parameters = let sandbox_parameters =