Backblaze, db bugfixes and connection testing.
This commit is contained in:
136
src/db.scm
136
src/db.scm
@@ -7,6 +7,9 @@
|
||||
|
||||
create-user delete-user
|
||||
create-instance get-user-instances
|
||||
get-instance-ssh-pub-key get-instance-ssh-priv-key
|
||||
update-instance-ssh-pub-key
|
||||
get-instance-restic-password
|
||||
update-user-service-config get-user-service-config
|
||||
update-user-selected-apps get-user-selected-apps
|
||||
update-user-app-config get-user-app-config
|
||||
@@ -18,7 +21,7 @@
|
||||
update-deployment-progress get-deployment-progress
|
||||
get-most-recent-deployment-progress
|
||||
update-user-terraform-state get-user-terraform-state
|
||||
get-user-deployments
|
||||
get-dashboard
|
||||
)
|
||||
|
||||
(import scheme
|
||||
@@ -106,7 +109,7 @@
|
||||
(values (hexstring->blob user-key) (hexstring->blob user-iv) auth-user-id)))
|
||||
|
||||
(define (user-encrypt message user-key user-iv user-id)
|
||||
(encrypt message user-key user-iv (string->blob (number->string user-id))))
|
||||
(encrypt message user-key user-iv (string->blob (->string user-id))))
|
||||
|
||||
(define (user-encrypt-for-db message user-key user-iv user-id)
|
||||
(receive (message tag)
|
||||
@@ -115,7 +118,7 @@
|
||||
(blob->hexstring/uppercase (string->blob tag)))))
|
||||
|
||||
(define (user-decrypt message tag user-key user-iv user-id)
|
||||
(decrypt message tag user-key user-iv (string->blob (number->string user-id))))
|
||||
(decrypt message tag user-key user-iv (string->blob (->string user-id))))
|
||||
|
||||
(define (user-decrypt-from-db message-and-tag user-key user-iv user-id)
|
||||
(let ((raw-message (hexstring->blob (string-drop-right message-and-tag (* tag-length 2))))
|
||||
@@ -141,16 +144,57 @@ returning users.user_id;"
|
||||
(define (delete-user conn user-id)
|
||||
(query conn "delete from users where user_id=$1;" user-id))
|
||||
|
||||
(define (create-instance conn user-id)
|
||||
(let ((instance-id
|
||||
(value-at
|
||||
(query conn
|
||||
"insert into instances(user_id) values ($1) returning instances.instance_id;" user-id))))
|
||||
(query conn "insert into user_service_configs(user_id, instance_id) values ($1, $2);" user-id instance-id)
|
||||
(query conn "insert into user_selected_apps(user_id, instance_id) values ($1, $2);" user-id instance-id)
|
||||
(query conn "insert into user_app_configs(user_id, instance_id) values ($1, $2);" user-id instance-id)
|
||||
(query conn "insert into user_terraform_state(user_id, instance_id) values ($1, $2);" user-id instance-id)
|
||||
instance-id))
|
||||
;; We also encrypt the ssh pub key not to hide it but to make it
|
||||
;; more difficult for someone to tamper with it which could allow
|
||||
;; an attacker to poison an instance with an ssh key that they have
|
||||
;; access to
|
||||
(define (create-instance conn user-id ssh-key-priv ssh-key-pub restic-password)
|
||||
(receive (user-key user-iv auth-user-id)
|
||||
(get-decrypted-user-key-and-iv conn user-id)
|
||||
(let ((instance-id
|
||||
(value-at
|
||||
(query conn
|
||||
"insert into instances(user_id, ssh_key_priv_enc, ssh_key_pub_enc, restic_password_enc) values ($1, $2, $3, $4) returning instances.instance_id;"
|
||||
user-id
|
||||
(user-encrypt-for-db ssh-key-priv user-key user-iv user-id)
|
||||
(user-encrypt-for-db ssh-key-pub user-key user-iv user-id)
|
||||
(user-encrypt-for-db restic-password user-key user-iv user-id)))))
|
||||
(query conn "insert into user_service_configs(user_id, instance_id) values ($1, $2);" user-id instance-id)
|
||||
(query conn "insert into user_selected_apps(user_id, instance_id) values ($1, $2);" user-id instance-id)
|
||||
(query conn "insert into user_app_configs(user_id, instance_id) values ($1, $2);" user-id instance-id)
|
||||
(query conn "insert into user_terraform_state(user_id, instance_id) values ($1, $2);" user-id instance-id)
|
||||
instance-id)))
|
||||
|
||||
(define (get-instance-ssh-priv-key conn user-id instance-id)
|
||||
(receive (user-key user-iv auth-user-id)
|
||||
(get-decrypted-user-key-and-iv conn user-id)
|
||||
(user-decrypt-from-db
|
||||
(value-at (query conn "select ssh_key_priv_enc from instances where user_id=$1 and instance_id=$2;"
|
||||
user-id instance-id))
|
||||
user-key user-iv user-id)))
|
||||
|
||||
(define (get-instance-ssh-pub-key conn user-id instance-id)
|
||||
(receive (user-key user-iv auth-user-id)
|
||||
(get-decrypted-user-key-and-iv conn user-id)
|
||||
(user-decrypt-from-db
|
||||
(value-at (query conn "select ssh_key_pub_enc from instances where user_id=$1 and instance_id=$2;"
|
||||
user-id instance-id))
|
||||
user-key user-iv user-id)))
|
||||
|
||||
(define (update-instance-ssh-pub-key conn user-id instance-id ssh-pub-key)
|
||||
(receive (user-key user-iv auth-user-id)
|
||||
(get-decrypted-user-key-and-iv conn user-id)
|
||||
(query conn "update instances set ssh_key_pub_enc=$3 where user_id=$1 and instance_id=$2;"
|
||||
user-id instance-id
|
||||
(user-encrypt-for-db ssh-pub-key user-key user-iv user-id))))
|
||||
|
||||
(define (get-instance-restic-password conn user-id instance-id)
|
||||
(receive (user-key user-iv auth-user-id)
|
||||
(get-decrypted-user-key-and-iv conn user-id)
|
||||
(user-decrypt-from-db
|
||||
(value-at (query conn "select restic_password_enc from instances where user_id=$1 and instance_id=$2;"
|
||||
user-id instance-id))
|
||||
user-key user-iv user-id)))
|
||||
|
||||
(define (get-user-instances conn user-id)
|
||||
(column-values (query conn "select instance_id from instances where user_id=$1;" user-id)))
|
||||
@@ -411,34 +455,50 @@ returning users.user_id;"
|
||||
value)))))
|
||||
res)))
|
||||
|
||||
(define (get-user-deployments conn user-id)
|
||||
(let* ((res-raw
|
||||
(query conn
|
||||
(string-append
|
||||
"select "
|
||||
(string-intersperse
|
||||
(map-in-order (lambda (d) (string-append "d." (cdr d))) *deployments-column-map*)
|
||||
", ")
|
||||
", uac.root_domain"
|
||||
" from deployments as d "
|
||||
"join user_app_configs uac on uac.user_id = d.user_id and uac.instance_id = d.instance_id"
|
||||
" where d.user_id=$1 order by d.id DESC limit 1;")
|
||||
user-id))
|
||||
(res (if (> (row-count res-raw) 0) (row-alist res-raw) '())))
|
||||
(if (null? res)
|
||||
'()
|
||||
;; I think this is just a hack as currently we only return 1 deployment
|
||||
(list
|
||||
(define (get-dashboard conn user-id)
|
||||
(receive (user-key user-iv auth-user-id)
|
||||
(get-decrypted-user-key-and-iv conn user-id)
|
||||
(let ((res
|
||||
(query conn
|
||||
(string-append
|
||||
"select "
|
||||
(string-intersperse
|
||||
(map-in-order (lambda (d) (string-append "d." (cdr d))) *deployments-column-map*)
|
||||
", ")
|
||||
", uac.root_domain, uac.config_enc, uac.instance_id, "
|
||||
"usa.wg_easy_version, usa.nextcloud_version, usa.log_viewer_version, usa.ghost_version "
|
||||
"from instances as i "
|
||||
"join (select instance_id, max(id) as id from deployments group by instance_id) d2 "
|
||||
"on d2.instance_id = i.instance_id "
|
||||
"join deployments d on d.id = d2.id "
|
||||
"join user_app_configs uac on uac.user_id = d.user_id and uac.instance_id = d.instance_id "
|
||||
"join user_selected_apps usa on usa.instance_id = uac.instance_id "
|
||||
"where i.user_id=$1;")
|
||||
user-id)))
|
||||
(map
|
||||
(lambda (row-num)
|
||||
(map (lambda (item)
|
||||
(let* ((key (car item))
|
||||
(value (cdr item))
|
||||
(config (alist-ref key (cons '(root_domain . root-domain) *deployments-reverse-column-map*))))
|
||||
(config (alist-ref key `((root_domain . root-domain)
|
||||
(config_enc . config)
|
||||
(instance_id . instance-id)
|
||||
(wg_easy_version . wg-easy)
|
||||
(nextcloud_version . nextcloud)
|
||||
(ghost_version . ghost)
|
||||
(log_viewer_version . log-viewer)
|
||||
,@*deployments-reverse-column-map*))))
|
||||
`(,config . ,(if (sql-null? value)
|
||||
#f
|
||||
(if (string? value)
|
||||
(if (and (string? value) (member config *deployments-column-map*))
|
||||
(string->symbol value)
|
||||
value)))))
|
||||
res)))))
|
||||
(if (eq? key 'config_enc)
|
||||
(with-input-from-string
|
||||
(user-decrypt-from-db value user-key user-iv user-id)
|
||||
read)
|
||||
value))))))
|
||||
(row-alist res row-num)))
|
||||
(iota (row-count res))))))
|
||||
|
||||
(define (update-user-terraform-state conn user-id instance-id state backup)
|
||||
(receive (user-key user-iv auth-user-id)
|
||||
@@ -456,10 +516,12 @@ returning users.user_id;"
|
||||
(let ((res (row-alist (query conn
|
||||
"select state_enc, state_backup_enc from user_terraform_state where user_id=$1 and instance_id=$2;"
|
||||
user-id instance-id))))
|
||||
`((state . ,(if (sql-null? (alist-ref 'config_enc res))
|
||||
`((state . ,(if (or (sql-null? (alist-ref 'config_enc res))
|
||||
(sql-null? (alist-ref 'state_enc res)))
|
||||
""
|
||||
(user-decrypt-from-db (alist-ref 'state_enc res) user-key user-iv user-id)))
|
||||
(backup . ,(if (sql-null? (alist-ref 'config_enc res))
|
||||
(backup . ,(if (or (sql-null? (alist-ref 'config_enc res))
|
||||
(sql-null? (alist-ref 'state_backup_enc res)))
|
||||
""
|
||||
(user-decrypt-from-db (alist-ref 'state_backup_enc res) user-key user-iv user-id)))))))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user