Robur
2 years ago
parent
d986d614a8
commit
eaf8a609c9
@ -0,0 +1,108 @@ |
||||
open Rresult.R.Infix |
||||
|
||||
let new_version = 6L and old_version = 5L |
||||
|
||||
let new_user = |
||||
Caqti_request.exec |
||||
Caqti_type.unit |
||||
{| CREATE TABLE new_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, |
||||
restricted BOOLEAN NOT NULL |
||||
) |
||||
|} |
||||
|
||||
let old_user = |
||||
Caqti_request.exec |
||||
Caqti_type.unit |
||||
{| CREATE TABLE new_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 collect_old_user = |
||||
Caqti_request.collect |
||||
Caqti_type.unit |
||||
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup3 int64 int64 int64)) |
||||
"SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p FROM user" |
||||
|
||||
let collect_new_user = |
||||
Caqti_request.collect |
||||
Caqti_type.unit |
||||
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup4 int64 int64 int64 bool)) |
||||
"SELECT id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted FROM user" |
||||
|
||||
let insert_new_user = |
||||
Caqti_request.exec |
||||
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup4 int64 int64 int64 bool)) |
||||
"INSERT INTO new_user (id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p, restricted) VALUES (?, ?, ?, ?, ?, ?, ?, ?)" |
||||
|
||||
let insert_old_user = |
||||
Caqti_request.exec |
||||
Caqti_type.(tup4 int64 string (tup2 octets octets) (tup3 int64 int64 int64)) |
||||
"INSERT INTO new_user (id, username, password_hash, password_salt, scrypt_n, scrypt_r, scrypt_p) VALUES (?, ?, ?, ?, ?, ?, ?)" |
||||
|
||||
let drop_user = |
||||
Caqti_request.exec |
||||
Caqti_type.unit |
||||
"DROP TABLE user" |
||||
|
||||
let rename_new_user = |
||||
Caqti_request.exec |
||||
Caqti_type.unit |
||||
"ALTER TABLE new_user RENAME TO user" |
||||
|
||||
let access_list = |
||||
Caqti_request.exec |
||||
Caqti_type.unit |
||||
{| CREATE TABLE access_list ( |
||||
id INTEGER PRIMARY KEY AUTOINCREMENT NOT NULL, |
||||
user INTEGER NOT NULL, |
||||
job INTEGER NOT NULL, |
||||
|
||||
FOREIGN KEY(user) REFERENCES user(id), |
||||
FOREIGN KEY(job) REFERENCES job(id), |
||||
UNIQUE(user, job) |
||||
) |
||||
|} |
||||
|
||||
let rollback_access_list = |
||||
Caqti_request.exec |
||||
Caqti_type.unit |
||||
"DROP TABLE IF EXISTS access_list" |
||||
|
||||
let migrate _datadir (module Db : Caqti_blocking.CONNECTION) = |
||||
Grej.check_version ~user_version:old_version (module Db) >>= fun () -> |
||||
Db.exec new_user () >>= fun () -> |
||||
Db.collect_list collect_old_user () >>= fun users -> |
||||
Grej.list_iter_result (fun (id, username, (password_hash, password_salt), (scrypt_n, scrypt_r, scrypt_p)) -> |
||||
Db.exec insert_new_user (id, username, (password_hash, password_salt), (scrypt_n, scrypt_r, scrypt_p, false))) |
||||
users >>= fun () -> |
||||
Db.exec drop_user () >>= fun () -> |
||||
Db.exec rename_new_user () >>= fun () -> |
||||
Db.exec access_list () >>= fun () -> |
||||
Db.exec (Grej.set_version new_version) () |
||||
|
||||
let rollback _datadir (module Db : Caqti_blocking.CONNECTION) = |
||||
Grej.check_version ~user_version:new_version (module Db) >>= fun () -> |
||||
Db.exec old_user () >>= fun () -> |
||||
Db.collect_list collect_new_user () >>= fun users -> |
||||
Grej.list_iter_result (fun (id, username, (password_hash, password_salt), (scrypt_n, scrypt_r, scrypt_p, restricted)) -> |
||||
if restricted then Logs.warn (fun m -> m "elevating privileges of restricted user %s" username); |
||||
Db.exec insert_old_user (id, username, (password_hash, password_salt), (scrypt_n, scrypt_r, scrypt_p))) |
||||
users >>= fun () -> |
||||
Db.exec drop_user () >>= fun () -> |
||||
Db.exec rename_new_user () >>= fun () -> |
||||
Db.exec rollback_access_list () >>= fun () -> |
||||
Db.exec (Grej.set_version old_version) () |
||||
@ -0,0 +1,54 @@ |
||||
|
||||
let src = Logs.Src.create "authorization" ~doc:"Builder_web authorization" |
||||
module Log = (val Logs.src_log src : Logs.LOG) |
||||
|
||||
open Lwt.Syntax |
||||
|
||||
let realm = "builder-web" |
||||
|
||||
let user_info_local = Dream.new_local ~name:"user_info" () |
||||
|
||||
let authenticate handler = fun req -> |
||||
let unauthorized () = |
||||
let headers = ["WWW-Authenticate", Printf.sprintf "Basic realm=\"%s\"" realm] in |
||||
Dream.respond ~headers ~status:`Unauthorized "Forbidden!" |
||||
in |
||||
match Dream.header "Authorization" req with |
||||
| None -> unauthorized () |
||||
| Some data -> match String.split_on_char ' ' data with |
||||
| [ "Basic" ; user_pass ] -> |
||||
(match Base64.decode user_pass with |
||||
| Error `Msg msg -> |
||||
Log.info (fun m -> m "Invalid user / pasword encoding in %S: %S" data msg); |
||||
Dream.respond ~status:`Bad_Request "Couldn't decode authorization" |
||||
| Ok user_pass -> match String.split_on_char ':' user_pass with |
||||
| [] | [_] -> |
||||
Log.info (fun m -> m "Invalid user / pasword encoding in %S" data); |
||||
Dream.respond ~status:`Bad_Request "Couldn't decode authorization" |
||||
| user :: password -> |
||||
let pass = String.concat ":" password in |
||||
let* user_info = Dream.sql req (Model.user user) in |
||||
match user_info with |
||||
| Ok (Some (id, user_info)) -> |
||||
if Builder_web_auth.verify_password pass user_info |
||||
then handler (Dream.with_local user_info_local (id, user_info) req) |
||||
else unauthorized () |
||||
| Ok None -> |
||||
let _ : _ Builder_web_auth.user_info = |
||||
Builder_web_auth.hash ~username:user ~password:pass ~restricted:true () in |
||||
unauthorized () |
||||
| Error e -> |
||||
Log.warn (fun m -> m "Error getting user: %a" Model.pp_error e); |
||||
Dream.respond ~status:`Internal_Server_Error "Internal server error") |
||||
| _ -> |
||||
Log.warn (fun m -> m "Error retrieving authorization %S" data); |
||||
Dream.respond ~status:`Bad_Request "Couldn't decode authorization" |
||||
|
||||
let authorized req job_name = |
||||
match Dream.local user_info_local req with |
||||
| None -> Lwt.return (Error (`Msg "not authenticated")) |
||||
| Some (id, user) -> |
||||
if user.restricted then |
||||
Dream.sql req (Model.authorized id job_name) |
||||
else |
||||
Lwt_result.return () |
||||
Loading…
Reference in new issue