Use scrypt (#32)

Switch to using scrypt for password hashing

Co-authored-by: Reynir Björnsson <reynir@reynir.dk>
Reviewed-on: https://git.robur.io/robur/builder-web/pulls/32
Co-Authored-By: reynir <reynir@reynir.dk>
Co-Committed-By: reynir <reynir@reynir.dk>
This commit is contained in:
Reynir Björnsson 2021-02-23 15:20:18 +00:00
parent 8d211dc831
commit 7b81d78554
11 changed files with 168 additions and 66 deletions

View file

@ -1,51 +1,50 @@
let prf : Mirage_crypto.Hash.hash = `SHA256 type pbkdf2_sha256_params = {
let default_count = 160_000 pbkdf2_sha256_iter : int;
let dk_len = 32l
type user_info = {
username : string;
password_hash : Cstruct.t;
password_salt : Cstruct.t;
password_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 } = type pbkdf2_sha256 =
Sexplib.Sexp.(List [ [ `Pbkdf2_sha256 of Cstruct.t * Cstruct.t * pbkdf2_sha256_params ]
Atom "user_info";
Atom username;
Atom (Cstruct.to_string password_hash);
Atom (Cstruct.to_string password_salt);
Sexplib.Conv.sexp_of_int password_iter;
])
let user_info_of_sexp = type scrypt = [ `Scrypt of Cstruct.t * Cstruct.t * scrypt_params ]
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
let h count salt password = type password_hash = [ pbkdf2_sha256 | scrypt ]
Pbkdf.pbkdf2 ~prf ~count ~dk_len ~salt ~password:(Cstruct.of_string password)
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 salt = Mirage_crypto_rng.generate 16 in
let password_hash = h password_iter salt password in let password_hash = scrypt ~params:scrypt_params ~salt ~password in
{ username; password_hash; password_salt = salt; password_iter } {
username;
password_hash = `Scrypt (password_hash, salt, scrypt_params)
}
let verify_password password user_info = let verify_password password user_info =
match user_info.password_hash with
| `Pbkdf2_sha256 (password_hash, salt, params) ->
Cstruct.equal Cstruct.equal
(h user_info.password_iter user_info.password_salt password) (pbkdf2_sha256 ~params ~salt ~password)
user_info.password_hash password_hash
| `Scrypt (password_hash, salt, params) ->
Cstruct.equal
(scrypt ~params ~salt ~password)
password_hash

View file

@ -1,3 +1,3 @@
(library (library
(name builder_web_auth) (name builder_web_auth)
(libraries pbkdf mirage-crypto-rng sexplib)) (libraries pbkdf scrypt-kdf mirage-crypto-rng sexplib))

View file

@ -20,7 +20,8 @@ let do_migrate dbpath =
let migrate () dbpath = let migrate () dbpath =
or_die 1 (do_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 = let r =
Caqti_blocking.connect Caqti_blocking.connect
(Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ()) (Uri.make ~scheme:"sqlite3" ~path:dbpath ~query:["create", ["false"]] ())
@ -29,7 +30,7 @@ let user_mod action dbpath password_iter username =
flush stdout; flush stdout;
(* FIXME: getpass *) (* FIXME: getpass *)
let password = read_line () in 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 match action with
| `Add -> | `Add ->
Db.exec Builder_db.User.add user_info Db.exec Builder_db.User.add user_info
@ -38,9 +39,9 @@ let user_mod action dbpath password_iter username =
in in
or_die 1 r 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 user_list () dbpath =
let r = let r =
@ -93,6 +94,24 @@ let password_iter =
opt (some int) None & opt (some int) None &
info ~doc ["hash-count"]) 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 =
let setup_log level = let setup_log level =
Logs.set_level level; Logs.set_level level;
@ -108,12 +127,12 @@ let migrate_cmd =
let user_add_cmd = let user_add_cmd =
let doc = "add a user" in 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") Cmdliner.Term.info ~doc "user-add")
let user_update_cmd = let user_update_cmd =
let doc = "update a user password" in 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") Cmdliner.Term.info ~doc "user-update")
let user_remove_cmd = let user_remove_cmd =

View file

@ -75,6 +75,16 @@ let r20210202 =
Cmdliner.Term.(const do_database_action $ const M20210202.rollback $ setup_log $ dbpath), Cmdliner.Term.(const do_database_action $ const M20210202.rollback $ setup_log $ dbpath),
Cmdliner.Term.info ~doc "rollback-2021-02-02" 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 help_cmd =
let topic = let topic =
let doc = "Migration to get help on" in let doc = "Migration to get help on" in
@ -95,5 +105,6 @@ let () =
[ help_cmd; [ help_cmd;
m20210126; r20210126; m20210126; r20210126;
m20210202; r20210202; m20210202; r20210202;
m20210216; r20210216;
] ]
|> Cmdliner.Term.exit |> Cmdliner.Term.exit

View file

@ -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) ()

View file

@ -22,6 +22,7 @@ depends: [
"pbkdf" "pbkdf"
"mirage-crypto-rng" "mirage-crypto-rng"
"sexplib" "sexplib"
"scrypt-kdf"
] ]
synopsis: "Web interface for builder" synopsis: "Web interface for builder"

View file

@ -4,7 +4,7 @@ open Rep
let application_id = 1234839235l let application_id = 1234839235l
(* Please update this when making changes! *) (* Please update this when making changes! *)
let current_version = 1L let current_version = 2L
type id = Rep.id type id = Rep.id
@ -416,7 +416,9 @@ module User = struct
username VARCHAR(255) NOT NULL UNIQUE, username VARCHAR(255) NOT NULL UNIQUE,
password_hash BLOB NOT NULL, password_hash BLOB NOT NULL,
password_salt 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_request.find_opt
Caqti_type.string Caqti_type.string
(Caqti_type.tup2 id user_info) (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 FROM user
WHERE username = ? WHERE username = ?
|} |}
@ -443,8 +446,9 @@ module User = struct
let add = let add =
Caqti_request.exec Caqti_request.exec
user_info user_info
{| INSERT INTO user (username, password_hash, password_salt, password_iter) {| INSERT INTO user (username, password_hash, password_salt,
VALUES (?, ?, ?, ?) scrypt_n, scrypt_r, scrypt_p)
VALUES (?, ?, ?, ?, ?, ?)
|} |}
let remove = let remove =
@ -463,7 +467,9 @@ module User = struct
{| UPDATE user {| UPDATE user
SET password_hash = ?2, SET password_hash = ?2,
password_salt = ?3, password_salt = ?3,
password_iter = ?4 scrypt_n = ?4,
scrypt_r = ?5,
scrypt_p = ?6
WHERE username = ?1 WHERE username = ?1
|} |}
end end

View file

@ -138,19 +138,19 @@ module User : sig
val rollback : val rollback :
(unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (unit, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val get_user : 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 ]) [< `Many | `One | `Zero > `One `Zero ])
Caqti_request.t Caqti_request.t
val get_all : val get_all :
(unit, string, [ `Many | `One | `Zero ]) Caqti_request.t (unit, string, [ `Many | `One | `Zero ]) Caqti_request.t
val add : 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 Caqti_request.t
val remove : (id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t val remove : (id, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val remove_user : val remove_user :
(string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t (string, unit, [< `Many | `One | `Zero > `Zero ]) Caqti_request.t
val update_user : 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 Caqti_request.t
end end

View file

@ -106,12 +106,18 @@ let console =
Caqti_type.custom ~encode ~decode cstruct Caqti_type.custom ~encode ~decode cstruct
let user_info = let user_info =
let rep = Caqti_type.(tup4 string cstruct cstruct int) in let rep = Caqti_type.(tup4 string cstruct cstruct (tup3 int int int)) in
let encode { Builder_web_auth.username; password_hash; let encode { Builder_web_auth.username;
password_salt; password_iter } = password_hash = `Scrypt (password_hash, password_salt, {
Ok (username, password_hash, password_salt, password_iter) Builder_web_auth.scrypt_n; scrypt_r; scrypt_p
in }) }
let decode (username, password_hash, password_salt, password_iter) = =
Ok { Builder_web_auth.username; password_hash; password_salt; password_iter } Ok (username, password_hash, password_salt, (scrypt_n, scrypt_r, scrypt_p))
in 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 Caqti_type.custom ~encode ~decode rep

View file

@ -81,7 +81,7 @@ let authorized t handler = fun req ->
then handler req then handler req
else Lwt.return unauthorized else Lwt.return unauthorized
| Ok None -> | Ok None ->
let _ : Builder_web_auth.user_info = let _ : _ Builder_web_auth.user_info =
Builder_web_auth.hash ~username ~password () in Builder_web_auth.hash ~username ~password () in
Lwt.return unauthorized Lwt.return unauthorized
| Error e -> | Error e ->

View file

@ -30,7 +30,7 @@ val jobs : Caqti_lwt.connection ->
((Builder_db.id * string) list, [> error ]) result Lwt.t ((Builder_db.id * string) list, [> error ]) result Lwt.t
val user : string -> Caqti_lwt.connection -> 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 : val add_build :