robur/builder-web
4
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Use scrypt (#32)

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

79
auth/builder_web_auth.ml
View file

@ -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 =
match user_info.password_hash with
| `Pbkdf2_sha256 (password_hash, salt, params) ->
Cstruct.equal
(h user_info.password_iter user_info.password_salt password)
user_info.password_hash
(pbkdf2_sha256 ~params ~salt ~password)
password_hash
| `Scrypt (password_hash, salt, params) ->
Cstruct.equal
(scrypt ~params ~salt ~password)
password_hash

2
auth/dune
View file

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

31
bin/builder_db.ml
View file

@ -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 =

11
bin/migrations/builder_migrations.ml
View file

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

60
bin/migrations/m20210216.ml Normal file
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) ()

1
builder-web.opam
View file

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

18
db/builder_db.ml
View file

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

6
db/builder_db.mli
View file

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

20
db/representation.ml
View file

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

2
lib/builder_web.ml
View file

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

2
lib/model.mli
View file

@ -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 :