From 7b81d78554e89868971c1bc1a81c12d95f706a96 Mon Sep 17 00:00:00 2001 From: reynir Date: Tue, 23 Feb 2021 15:20:18 +0000 Subject: [PATCH] Use scrypt (#32) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Switch to using scrypt for password hashing Co-authored-by: Reynir Björnsson Reviewed-on: https://git.robur.io/robur/builder-web/pulls/32 Co-Authored-By: reynir Co-Committed-By: reynir --- auth/builder_web_auth.ml | 81 ++++++++++++++-------------- auth/dune | 2 +- bin/builder_db.ml | 31 ++++++++--- bin/migrations/builder_migrations.ml | 11 ++++ bin/migrations/m20210216.ml | 60 +++++++++++++++++++++ builder-web.opam | 1 + db/builder_db.ml | 18 ++++--- db/builder_db.mli | 6 +-- db/representation.ml | 20 ++++--- lib/builder_web.ml | 2 +- lib/model.mli | 2 +- 11 files changed, 168 insertions(+), 66 deletions(-) create mode 100644 bin/migrations/m20210216.ml diff --git a/auth/builder_web_auth.ml b/auth/builder_web_auth.ml index 3aa927d..e044b57 100644 --- a/auth/builder_web_auth.ml +++ b/auth/builder_web_auth.ml @@ -1,51 +1,50 @@ -let prf : Mirage_crypto.Hash.hash = `SHA256 -let default_count = 160_000 -let dk_len = 32l - -type user_info = { - username : string; - password_hash : Cstruct.t; - password_salt : Cstruct.t; - password_iter : int; +type pbkdf2_sha256_params = { + pbkdf2_sha256_iter : int; } -module SMap = Map.Make(String) +type scrypt_params = { + scrypt_n : int; + scrypt_r : int; + scrypt_p : int; +} -type t = user_info SMap.t +let scrypt_params ?(scrypt_n = 16384) ?(scrypt_r = 8) ?(scrypt_p = 1) () = + { scrypt_n; scrypt_r; scrypt_p } -let user_info_to_sexp { username; password_hash; password_salt; password_iter } = - Sexplib.Sexp.(List [ - Atom "user_info"; - Atom username; - Atom (Cstruct.to_string password_hash); - Atom (Cstruct.to_string password_salt); - Sexplib.Conv.sexp_of_int password_iter; - ]) +type pbkdf2_sha256 = + [ `Pbkdf2_sha256 of Cstruct.t * Cstruct.t * pbkdf2_sha256_params ] -let user_info_of_sexp = - let open Sexplib.Sexp in - function - | List [ Atom "user_info"; - Atom username; - Atom password_hash; - Atom password_salt; - (Atom _ ) as password_iter; ] -> - { username; - password_hash = Cstruct.of_string password_hash; - password_salt = Cstruct.of_string password_salt; - password_iter = Sexplib.Conv.int_of_sexp password_iter; } - | sexp -> - Sexplib.Conv.of_sexp_error "Auth_store.user_info_of_sexp: bad sexp" sexp +type scrypt = [ `Scrypt of Cstruct.t * Cstruct.t * scrypt_params ] -let h count salt password = - Pbkdf.pbkdf2 ~prf ~count ~dk_len ~salt ~password:(Cstruct.of_string password) +type password_hash = [ pbkdf2_sha256 | scrypt ] -let hash ?(password_iter=default_count) ~username ~password () = +type 'a user_info = { + username : string; + password_hash : [< password_hash ] as 'a; +} + +let pbkdf2_sha256 ~params:{ pbkdf2_sha256_iter = count } ~salt ~password = + Pbkdf.pbkdf2 ~prf:`SHA256 ~count ~dk_len:32l ~salt ~password:(Cstruct.of_string password) + +let scrypt ~params:{ scrypt_n = n; scrypt_r = r; scrypt_p = p } ~salt ~password = + Scrypt_kdf.scrypt_kdf ~n ~r ~p ~dk_len:32l ~salt ~password:(Cstruct.of_string password) + +let hash ?(scrypt_params=scrypt_params ()) + ~username ~password () = let salt = Mirage_crypto_rng.generate 16 in - let password_hash = h password_iter salt password in - { username; password_hash; password_salt = salt; password_iter } + let password_hash = scrypt ~params:scrypt_params ~salt ~password in + { + username; + password_hash = `Scrypt (password_hash, salt, scrypt_params) + } let verify_password password user_info = - Cstruct.equal - (h user_info.password_iter user_info.password_salt password) - user_info.password_hash + match user_info.password_hash with + | `Pbkdf2_sha256 (password_hash, salt, params) -> + Cstruct.equal + (pbkdf2_sha256 ~params ~salt ~password) + password_hash + | `Scrypt (password_hash, salt, params) -> + Cstruct.equal + (scrypt ~params ~salt ~password) + password_hash diff --git a/auth/dune b/auth/dune index 82b0e15..0b9509c 100644 --- a/auth/dune +++ b/auth/dune @@ -1,3 +1,3 @@ (library (name builder_web_auth) - (libraries pbkdf mirage-crypto-rng sexplib)) + (libraries pbkdf scrypt-kdf mirage-crypto-rng sexplib)) diff --git a/bin/builder_db.ml b/bin/builder_db.ml index 361c528..c55672a 100644 --- a/bin/builder_db.ml +++ b/bin/builder_db.ml @@ -20,7 +20,8 @@ let do_migrate dbpath = let migrate () dbpath = or_die 1 (do_migrate dbpath) -let user_mod action dbpath password_iter username = +let user_mod action dbpath scrypt_n scrypt_r scrypt_p username = + let scrypt_params = Builder_web_auth.scrypt_params ?scrypt_n ?scrypt_r ?scrypt_p () in let r = Caqti_blocking.connect (Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ()) @@ -29,7 +30,7 @@ let user_mod action dbpath password_iter username = flush stdout; (* FIXME: getpass *) let password = read_line () in - let user_info = Builder_web_auth.hash ?password_iter ~username ~password () in + let user_info = Builder_web_auth.hash ~scrypt_params ~username ~password () in match action with | `Add -> Db.exec Builder_db.User.add user_info @@ -38,9 +39,9 @@ let user_mod action dbpath password_iter username = in or_die 1 r -let user_add () dbpath username = user_mod `Add dbpath username +let user_add () dbpath = user_mod `Add dbpath -let user_update () dbpath username = user_mod `Update dbpath username +let user_update () dbpath = user_mod `Update dbpath let user_list () dbpath = let r = @@ -93,6 +94,24 @@ let password_iter = opt (some int) None & info ~doc ["hash-count"]) +let scrypt_n = + let doc = "scrypt n parameter" in + Cmdliner.Arg.(value & + opt (some int) None & + info ~doc ["scrypt-n"]) + +let scrypt_r = + let doc = "scrypt r parameter" in + Cmdliner.Arg.(value & + opt (some int) None & + info ~doc ["scrypt-r"]) + +let scrypt_p = + let doc = "scrypt p parameter" in + Cmdliner.Arg.(value & + opt (some int) None & + info ~doc ["scrypt-p"]) + let setup_log = let setup_log level = Logs.set_level level; @@ -108,12 +127,12 @@ let migrate_cmd = let user_add_cmd = let doc = "add a user" in - (Cmdliner.Term.(pure user_add $ setup_log $ dbpath $ password_iter $ username), + (Cmdliner.Term.(pure user_add $ setup_log $ dbpath $ scrypt_n $ scrypt_r $ scrypt_p $ username), Cmdliner.Term.info ~doc "user-add") let user_update_cmd = let doc = "update a user password" in - (Cmdliner.Term.(pure user_update $ setup_log $ dbpath $ password_iter $ username), + (Cmdliner.Term.(pure user_update $ setup_log $ dbpath $ scrypt_n $ scrypt_r $ scrypt_p $ username), Cmdliner.Term.info ~doc "user-update") let user_remove_cmd = diff --git a/bin/migrations/builder_migrations.ml b/bin/migrations/builder_migrations.ml index 26e0fa9..a5b9293 100644 --- a/bin/migrations/builder_migrations.ml +++ b/bin/migrations/builder_migrations.ml @@ -75,6 +75,16 @@ let r20210202 = Cmdliner.Term.(const do_database_action $ const M20210202.rollback $ setup_log $ dbpath), Cmdliner.Term.info ~doc "rollback-2021-02-02" +let m20210216 = + let doc = "Changes 'user' for scrypt hashed passwords (NB: Destructive!!) (2021-02-16)" in + Cmdliner.Term.(const do_database_action $ const M20210216.migrate $ setup_log $ dbpath), + Cmdliner.Term.info ~doc "migrate-2021-02-16" + +let r20210216 = + let doc = "Rollback scrypt hashed passwords (NB: Destructive!!) (2021-02-16)" in + Cmdliner.Term.(const do_database_action $ const M20210216.rollback $ setup_log $ dbpath), + Cmdliner.Term.info ~doc "rollback-2021-02-16" + let help_cmd = let topic = let doc = "Migration to get help on" in @@ -95,5 +105,6 @@ let () = [ help_cmd; m20210126; r20210126; m20210202; r20210202; + m20210216; r20210216; ] |> Cmdliner.Term.exit diff --git a/bin/migrations/m20210216.ml b/bin/migrations/m20210216.ml new file mode 100644 index 0000000..4c12319 --- /dev/null +++ b/bin/migrations/m20210216.ml @@ -0,0 +1,60 @@ +let old_user_version = 1L +let new_user_version = 2L + +let set_version version = + Caqti_request.exec ~oneshot:true + Caqti_type.unit + (Printf.sprintf "PRAGMA user_version = %Ld" version) + +let drop_user = + Caqti_request.exec ~oneshot:true + Caqti_type.unit + "DROP TABLE user" + +let new_user = + Caqti_request.exec ~oneshot:true + Caqti_type.unit + {| CREATE TABLE user ( + id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + username VARCHAR(255) NOT NULL UNIQUE, + password_hash BLOB NOT NULL, + password_salt BLOB NOT NULL, + scrypt_n INTEGER NOT NULL, + scrypt_r INTEGER NOT NULL, + scrypt_p INTEGER NOT NULL + ) + |} + +let old_user = + Caqti_request.exec + Caqti_type.unit + {| CREATE TABLE user ( + id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, + username VARCHAR(255) NOT NULL UNIQUE, + password_hash BLOB NOT NULL, + password_salt BLOB NOT NULL, + password_iter INTEGER NOT NULL + ) + |} + +let migrate (module Db : Caqti_blocking.CONNECTION) = + let open Rresult.R.Infix in + Db.find Builder_db.get_application_id () >>= fun application_id -> + Db.find Builder_db.get_version () >>= fun user_version -> + if application_id <> Builder_db.application_id || user_version <> old_user_version + then Error (`Wrong_version (application_id, user_version)) + else + Db.exec drop_user () >>= fun () -> + Db.exec new_user () >>= fun () -> + Db.exec (set_version new_user_version) () + +let rollback (module Db : Caqti_blocking.CONNECTION) = + let open Rresult.R.Infix in + Db.find Builder_db.get_application_id () >>= fun application_id -> + Db.find Builder_db.get_version () >>= fun user_version -> + if application_id <> Builder_db.application_id || user_version <> new_user_version + then Error (`Wrong_version (application_id, user_version)) + else + Db.exec drop_user () >>= fun () -> + Db.exec old_user () >>= fun () -> + Db.exec (set_version old_user_version) () diff --git a/builder-web.opam b/builder-web.opam index 4b308d7..7d7a184 100644 --- a/builder-web.opam +++ b/builder-web.opam @@ -22,6 +22,7 @@ depends: [ "pbkdf" "mirage-crypto-rng" "sexplib" + "scrypt-kdf" ] synopsis: "Web interface for builder" diff --git a/db/builder_db.ml b/db/builder_db.ml index f221f83..255f473 100644 --- a/db/builder_db.ml +++ b/db/builder_db.ml @@ -4,7 +4,7 @@ open Rep let application_id = 1234839235l (* Please update this when making changes! *) -let current_version = 1L +let current_version = 2L type id = Rep.id @@ -416,7 +416,9 @@ module User = struct username VARCHAR(255) NOT NULL UNIQUE, password_hash BLOB NOT NULL, password_salt BLOB NOT NULL, - password_iter INTEGER NOT NULL + scrypt_n INTEGER NOT NULL, + scrypt_r INTEGER NOT NULL, + scrypt_p INTEGER NOT NULL ) |} @@ -429,7 +431,8 @@ module User = struct Caqti_request.find_opt Caqti_type.string (Caqti_type.tup2 id user_info) - {| SELECT id, username, password_hash, password_salt, password_iter + {| SELECT id, username, password_hash, password_salt, + scrypt_n, scrypt_r, scrypt_p FROM user WHERE username = ? |} @@ -443,8 +446,9 @@ module User = struct let add = Caqti_request.exec user_info - {| INSERT INTO user (username, password_hash, password_salt, password_iter) - VALUES (?, ?, ?, ?) + {| INSERT INTO user (username, password_hash, password_salt, + scrypt_n, scrypt_r, scrypt_p) + VALUES (?, ?, ?, ?, ?, ?) |} let remove = @@ -463,7 +467,9 @@ module User = struct {| UPDATE user SET password_hash = ?2, password_salt = ?3, - password_iter = ?4 + scrypt_n = ?4, + scrypt_r = ?5, + scrypt_p = ?6 WHERE username = ?1 |} end diff --git a/db/builder_db.mli b/db/builder_db.mli index 80a1e88..b669a87 100644 --- a/db/builder_db.mli +++ b/db/builder_db.mli @@ -138,19 +138,19 @@ module User : sig val rollback : (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val get_user : - (string, id * Builder_web_auth.user_info, + (string, id * Builder_web_auth.scrypt Builder_web_auth.user_info, [< `Many | `One | `Zero > `One `Zero ]) Caqti_request.t val get_all : (unit, string, [ `Many | `One | `Zero ]) Caqti_request.t val add : - (Builder_web_auth.user_info, unit, [< `Many | `One | `Zero > `Zero ]) + (Builder_web_auth.scrypt Builder_web_auth.user_info, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val remove : (id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val remove_user : (string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val update_user : - (Builder_web_auth.user_info, unit, [< `Many | `One | `Zero > `Zero ]) + (Builder_web_auth.scrypt Builder_web_auth.user_info, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t end diff --git a/db/representation.ml b/db/representation.ml index 482339f..6ac5ba1 100644 --- a/db/representation.ml +++ b/db/representation.ml @@ -106,12 +106,18 @@ let console = Caqti_type.custom ~encode ~decode cstruct let user_info = - let rep = Caqti_type.(tup4 string cstruct cstruct int) in - let encode { Builder_web_auth.username; password_hash; - password_salt; password_iter } = - Ok (username, password_hash, password_salt, password_iter) - in - let decode (username, password_hash, password_salt, password_iter) = - Ok { Builder_web_auth.username; password_hash; password_salt; password_iter } + let rep = Caqti_type.(tup4 string cstruct cstruct (tup3 int int int)) in + let encode { Builder_web_auth.username; + password_hash = `Scrypt (password_hash, password_salt, { + Builder_web_auth.scrypt_n; scrypt_r; scrypt_p + }) } + = + Ok (username, password_hash, password_salt, (scrypt_n, scrypt_r, scrypt_p)) in + let decode (username, password_hash, password_salt, (scrypt_n, scrypt_r, scrypt_p)) = + Ok { Builder_web_auth.username; + password_hash = + `Scrypt (password_hash, password_salt, + { Builder_web_auth.scrypt_n; + scrypt_r; scrypt_p }) } in Caqti_type.custom ~encode ~decode rep diff --git a/lib/builder_web.ml b/lib/builder_web.ml index 67b15c8..14e4b85 100644 --- a/lib/builder_web.ml +++ b/lib/builder_web.ml @@ -81,7 +81,7 @@ let authorized t handler = fun req -> then handler req else Lwt.return unauthorized | Ok None -> - let _ : Builder_web_auth.user_info = + let _ : _ Builder_web_auth.user_info = Builder_web_auth.hash ~username ~password () in Lwt.return unauthorized | Error e -> diff --git a/lib/model.mli b/lib/model.mli index 7f93cb6..0c59fb1 100644 --- a/lib/model.mli +++ b/lib/model.mli @@ -30,7 +30,7 @@ val jobs : Caqti_lwt.connection -> ((Builder_db.id * string) list, [> error ]) result Lwt.t val user : string -> Caqti_lwt.connection -> - (Builder_web_auth.user_info option, [> error ]) result Lwt.t + (Builder_web_auth.scrypt Builder_web_auth.user_info option, [> error ]) result Lwt.t val add_build :