Compare commits

..

11 Commits

17 changed files with 646 additions and 418 deletions

View File

@@ -111,11 +111,11 @@ preapply: app/.dirstamp
apply: announce-start restic-init ignition.json $(config_dir)$(TERRAFORM_ENV).tfvars generated.tfvars apply: announce-start restic-init ignition.json $(config_dir)$(TERRAFORM_ENV).tfvars generated.tfvars
echo "NASSELLA_CONFIG: end" echo "NASSELLA_CONFIG: end"
terraform init terraform init --upgrade
bash -c "terraform apply -auto-approve -input=false -var-file=<(cat $(config_dir)$(TERRAFORM_ENV).tfvars generated.tfvars)" bash -c "terraform apply -auto-approve -input=false -var-file=<(cat $(config_dir)$(TERRAFORM_ENV).tfvars generated.tfvars)"
destroy: ignition.json $(config_dir)$(TERRAFORM_ENV).tfvars generated.tfvars destroy: ignition.json $(config_dir)$(TERRAFORM_ENV).tfvars generated.tfvars
terraform init terraform init --upgrade
bash -c "terraform destroy -auto-approve -input=false -var-file=<(cat $(config_dir)$(TERRAFORM_ENV).tfvars generated.tfvars)" bash -c "terraform destroy -auto-approve -input=false -var-file=<(cat $(config_dir)$(TERRAFORM_ENV).tfvars generated.tfvars)"
.PHONY: restic-init .PHONY: restic-init

View File

@@ -14,8 +14,17 @@
# You should have received a copy of the GNU Affero General Public License # You should have received a copy of the GNU Affero General Public License
# along with Nassella. If not, see <https://www.gnu.org/licenses/>. # along with Nassella. If not, see <https://www.gnu.org/licenses/>.
{$authelia_SUBDOMAIN}.{$ROOT_DOMAIN} { #{$authelia_SUBDOMAIN}.{$ROOT_DOMAIN} {
import maintenance_intercept # route {
# @authelia path /authelia /authelia/*
# handle @authelia {
# reverse_proxy authelia:9091
# }
# forward_auth authelia:9091 {
# uri /api/authz/forward-auth
# copy_headers Remote-User Remote-Groups Remote-Email Remote-Name
# }
# reverse_proxy authelia:9091
# }
#}
reverse_proxy authelia:9091
}

View File

@@ -18,7 +18,8 @@ IMAGE_DEPS := $(IMAGE_DEPS) \
app/authelia/postgres_db \ app/authelia/postgres_db \
app/authelia/postgres_user \ app/authelia/postgres_user \
app/authelia/postgres_password \ app/authelia/postgres_password \
app/authelia/authelia-config/configuration.yml app/authelia/authelia-config/configuration.yml \
app/authelia/authelia-config/users.yml
app/authelia/postgres_db: $(apps_config) app/authelia/postgres_db: $(apps_config)
bash -c 'source ./$(apps_config); printf "%s\n" "$$AUTHELIA_POSTGRES_DB" > $@' bash -c 'source ./$(apps_config); printf "%s\n" "$$AUTHELIA_POSTGRES_DB" > $@'
@@ -29,3 +30,6 @@ app/authelia/postgres_password: $(apps_config)
app/authelia/authelia-config/configuration.yml: $(apps_config) app/authelia/authelia-config/configuration.yml.tmpl \ app/authelia/authelia-config/configuration.yml: $(apps_config) app/authelia/authelia-config/configuration.yml.tmpl \
app/authelia/make-authelia-config.sh app/authelia/make-authelia-config.sh
./app/authelia/make-authelia-config.sh $(apps_config) ./app/authelia/make-authelia-config.sh $(apps_config)
app/authelia/authelia-config/users.yml: $(apps_config) app/authelia/authelia-config/users.yml.tmpl \
app/authelia/make-authelia-users-config.sh
./app/authelia/make-authelia-users-config.sh $(apps_config)

View File

@@ -35,58 +35,45 @@ identity_validation:
reset_password: reset_password:
jwt_secret: '$AUTHELIA_JWT_SECRET' jwt_secret: '$AUTHELIA_JWT_SECRET'
# lldap service account user should instead
# use an account with lldap_password_manager group
# since that can't be used to change an admin password
authentication_backend: authentication_backend:
ldap: disable_reset_password: true
address: 'ldap://lldap:3890' file:
implementation: 'lldap' path: '/config/users.yml'
timeout: '5s' watch: false
pooling: search:
enable: false email: false
count: 5 case_insensitive: false
retries: 2 extra_attributes:
timeout: '10 seconds' extra_example:
base_dn: 'DC=nassella,DC=org' multi_valued: false
# additional_users_dn: 'OU=users' value_type: 'string'
# additional_groups_dn: 'OU=groups' password:
# group_search_mode: 'filter' algorithm: 'argon2'
# permit_referrals: false argon2:
permit_unauthenticated_bind: false variant: 'argon2id'
permit_feature_detection_failure: false iterations: 3
user: 'uid=admin,ou=people,dc=nassella,dc=org' memory: 65536
password: '$LLDAP_ADMIN_PASSWORD' parallelism: 4
# attributes: key_length: 32
# distinguished_name: 'distinguishedName' salt_length: 16
# username: 'uid' scrypt:
# display_name: 'displayName' variant: 'scrypt'
# family_name: 'sn' iterations: 16
# given_name: 'givenName' block_size: 8
# middle_name: 'middleName' parallelism: 1
# nickname: '' key_length: 32
# gender: '' salt_length: 16
# birthdate: '' pbkdf2:
# website: 'wWWHomePage' variant: 'sha512'
# profile: '' iterations: 310000
# picture: '' salt_length: 16
# zoneinfo: '' sha2crypt:
# locale: '' variant: 'sha512'
# phone_number: 'telephoneNumber' iterations: 50000
# phone_extension: '' salt_length: 16
# street_address: 'streetAddress' bcrypt:
# locality: 'l' variant: 'standard'
# region: 'st' cost: 12
# postal_code: 'postalCode'
# country: 'c'
# mail: 'mail'
# member_of: 'memberOf'
# group_name: 'cn'
# extra:
# extra_example:
# name: ''
# multi_valued: false
# value_type: 'string'
access_control: access_control:
default_policy: 'deny' default_policy: 'deny'
@@ -102,11 +89,12 @@ session:
secret: '$AUTHELIA_SESSION_SECRET' secret: '$AUTHELIA_SESSION_SECRET'
cookies: cookies:
- name: 'authelia_session' - name: 'dozzle_session'
domain: '$ROOT_DOMAIN' # Should match whatever your root protected domain is domain: '$DOZZLE_FULL_DOMAIN' # Should match whatever your root protected domain is
authelia_url: 'https://$AUTHELIA_FULL_DOMAIN' authelia_url: 'https://$DOZZLE_FULL_DOMAIN/authelia'
expiration: '1 hour' # 1 hour expiration: '1 hour' # 1 hour
inactivity: '5 minutes' # 5 minutes inactivity: '5 minutes' # 5 minutes
default_redirection_url: 'https://$DOZZLE_FULL_DOMAIN/'
regulation: regulation:
max_retries: 3 max_retries: 3

View File

@@ -0,0 +1,7 @@
# yaml-language-server: $schema=https://www.authelia.com/schemas/latest/json-schema/user-database.json
users:
admin:
disabled: false
displayname: 'Admin'
password: '$HOST_ADMIN_PASSWORD'
email: '$HOST_ADMIN_USER'

View File

@@ -50,13 +50,11 @@ services:
image: 'authelia/authelia' image: 'authelia/authelia'
volumes: volumes:
- ./authelia/authelia-config/configuration.yml:/config/configuration.yml:ro - ./authelia/authelia-config/configuration.yml:/config/configuration.yml:ro
- ./authelia/authelia-config/users.yml:/config/users.yml:ro
networks: networks:
- lb - lb
- authelia_internal_db - authelia_internal_db
- lldap_internal
depends_on: depends_on:
lldap:
condition: service_healthy
authelia_db: authelia_db:
condition: service_healthy condition: service_healthy
restart: 'unless-stopped' restart: 'unless-stopped'
@@ -66,9 +64,6 @@ services:
networks: networks:
lb: lb:
lldap_internal:
driver: bridge
internal: true
authelia_internal_db: authelia_internal_db:
driver: bridge driver: bridge
internal: true internal: true

View File

@@ -0,0 +1,24 @@
#!/bin/bash
# Copyright 2025-2026 Thomas Hintz
# This file is part of Nassella.
# Nassella is free software: you can redistribute it and/or modify it under the
# terms of the GNU Affero General Public License as published by the Free
# Software Foundation, either version 3 of the License, or (at your option) any
# later version.
# Nassella is distributed in the hope that it will be useful, but WITHOUT ANY
# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
# FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details.
# You should have received a copy of the GNU Affero General Public License
# along with Nassella. If not, see <https://www.gnu.org/licenses/>.
set -e
set -a # export everything in the config for later use by envsubst
. $1 # source the apps.config file with then env vars
envsubst < app/authelia/authelia-config/users.yml.tmpl > app/authelia/authelia-config/users.yml

View File

@@ -15,9 +15,15 @@
# along with Nassella. If not, see <https://www.gnu.org/licenses/>. # along with Nassella. If not, see <https://www.gnu.org/licenses/>.
{$dozzle_SUBDOMAIN}.{$ROOT_DOMAIN} { {$dozzle_SUBDOMAIN}.{$ROOT_DOMAIN} {
route {
@authelia path /authelia /authelia/*
handle @authelia {
reverse_proxy authelia:9091
}
forward_auth authelia:9091 { forward_auth authelia:9091 {
uri /api/authz/forward-auth uri /api/authz/forward-auth
copy_headers Remote-User Remote-Groups Remote-Email Remote-Name copy_headers Remote-User Remote-Groups Remote-Email Remote-Name
} }
reverse_proxy http://dozzle:8080 reverse_proxy http://dozzle:8080
}
} }

View File

@@ -84,7 +84,7 @@ access_control:
policy: 'two_factor' policy: 'two_factor'
session: session:
secret: 'insecure_session_secret' secret: 'insecure_session_secret' # TODO fix
cookies: cookies:
- name: 'authelia_session' - name: 'authelia_session'

28
main.tf
View File

@@ -2,23 +2,19 @@ terraform {
required_providers { required_providers {
digitalocean = { digitalocean = {
source = "digitalocean/digitalocean" source = "digitalocean/digitalocean"
version = "2.62.0" version = "2.96.0"
} }
ct = { ct = {
source = "poseidon/ct" source = "poseidon/ct"
version = "0.13.0" version = "0.14.0"
} }
null = { null = {
source = "hashicorp/null" source = "hashicorp/null"
version = "3.2.4" version = "3.3.0"
}
time = {
source = "hashicorp/time"
version = "0.13.1"
} }
cloudflare = { cloudflare = {
source = "cloudflare/cloudflare" source = "cloudflare/cloudflare"
version = "5.8.2" version = "5.22.0"
} }
} }
} }
@@ -86,6 +82,10 @@ variable "digitalocean_volume_size" {
provider "digitalocean" { provider "digitalocean" {
token = var.do_token token = var.do_token
http_retry_max = 10
http_retry_wait_min = 2
http_retry_wait_max = 60
} }
provider "cloudflare" { provider "cloudflare" {
@@ -142,21 +142,11 @@ resource "digitalocean_droplet" "machine" {
size = var.server_type size = var.server_type
ssh_keys = [digitalocean_ssh_key.first.fingerprint] ssh_keys = [digitalocean_ssh_key.first.fingerprint]
user_data = file("ignition.json") user_data = file("ignition.json")
lifecycle {
create_before_destroy = true
}
} }
resource "time_sleep" "wait_10_seconds" {
create_duration = "10s"
}
resource "digitalocean_reserved_ip_assignment" "machine" { resource "digitalocean_reserved_ip_assignment" "machine" {
depends_on = [digitalocean_volume_attachment.machine]
ip_address = digitalocean_reserved_ip.machine.ip_address ip_address = digitalocean_reserved_ip.machine.ip_address
droplet_id = digitalocean_droplet.machine.id droplet_id = digitalocean_droplet.machine.id
# sometimes digital ocean throws an error for this resource
# saying the droplet has a pending event so we delay a few seconds
depends_on = [time_sleep.wait_10_seconds]
} }
resource "digitalocean_volume_attachment" "machine" { resource "digitalocean_volume_attachment" "machine" {

View File

@@ -30,7 +30,7 @@ RUN chicken-install srfi-1 srfi-13 srfi-18 srfi-19 srfi-158 srfi-194 \
sxml-transforms schematra \ sxml-transforms schematra \
uri-common http-client medea intarweb \ uri-common http-client medea intarweb \
sql-null openssl postgresql crypto-tools \ sql-null openssl postgresql crypto-tools \
hmac sha2 string-utils hmac sha2 string-utils base64
WORKDIR /var WORKDIR /var
RUN mkdir nassella RUN mkdir nassella
@@ -45,6 +45,7 @@ RUN chmod +x nassella-run
FROM quay.io/coreos/butane:release AS butane FROM quay.io/coreos/butane:release AS butane
FROM hashicorp/terraform:1.15 AS terraform FROM hashicorp/terraform:1.15 AS terraform
FROM authelia/authelia:latest AS authelia
FROM debian:trixie-slim FROM debian:trixie-slim
RUN apt-get update && apt-get -y --no-install-recommends install \ RUN apt-get update && apt-get -y --no-install-recommends install \
@@ -53,6 +54,7 @@ RUN apt-get update && apt-get -y --no-install-recommends install \
COPY --from=butane /usr/local/bin/butane /usr/local/bin/butane COPY --from=butane /usr/local/bin/butane /usr/local/bin/butane
COPY --from=terraform /bin/terraform /usr/local/bin/terraform COPY --from=terraform /bin/terraform /usr/local/bin/terraform
COPY --from=authelia /app/authelia /usr/local/bin/authelia
COPY --from=buildeggs /usr/local/ /usr/local/ COPY --from=buildeggs /usr/local/ /usr/local/

View File

@@ -45,7 +45,9 @@ create table user_service_configs(
digitalocean_volume_size integer, digitalocean_volume_size integer,
backblaze_application_key_enc varchar(255), backblaze_application_key_enc varchar(255),
backblaze_key_id_enc varchar(255), backblaze_key_id_enc varchar(255),
backblaze_bucket_url_enc varchar(255) backblaze_bucket_url_enc varchar(255), -- deprecated 072526, replaced by bucket_name and bucket_id
backblaze_bucket_name_enc varchar(255),
backblaze_bucket_id_enc varchar(255)
); );
create unique index user_service_configs_user_id_instance_id_idx on user_service_configs (user_id, instance_id); create unique index user_service_configs_user_id_instance_id_idx on user_service_configs (user_id, instance_id);
@@ -91,7 +93,7 @@ create table user_app_configs(
create unique index user_app_configs_user_id_instance_id_idx on user_app_configs (user_id, instance_id); create unique index user_app_configs_user_id_instance_id_idx on user_app_configs (user_id, instance_id);
create type deployment_status as enum ('queued', 'in-progress', 'complete', 'failed'); create type deployment_status as enum ('ignored', 'queued', 'in-progress', 'complete', 'failed');
create table deployments( create table deployments(
id bigserial primary key, id bigserial primary key,

View File

@@ -248,7 +248,9 @@ returning users.user_id;"
(digitalocean-volume-size . ("digitalocean_volume_size" #f)) (digitalocean-volume-size . ("digitalocean_volume_size" #f))
(backblaze-application-key . ("backblaze_application_key_enc" #t)) (backblaze-application-key . ("backblaze_application_key_enc" #t))
(backblaze-key-id . ("backblaze_key_id_enc" #t)) (backblaze-key-id . ("backblaze_key_id_enc" #t))
(backblaze-bucket-url . ("backblaze_bucket_url_enc" #t)))) (backblaze-bucket-url . ("backblaze_bucket_url_enc" #t))
(backblaze-bucket-name . ("backblaze_bucket_name_enc" #t))
(backblaze-bucket-id . ("backblaze_bucket_id_enc" #t))))
(define *user-service-configs-reverse-column-map* (define *user-service-configs-reverse-column-map*
(map (lambda (config) (map (lambda (config)
@@ -376,7 +378,8 @@ where usa.user_id=$1 and usa.instance_id=$2;"
'((queued . "queued") '((queued . "queued")
(in-progress . "in-progress") (in-progress . "in-progress")
(complete . "complete") (complete . "complete")
(failed . "failed"))) (failed . "failed")
(ignored . "ignored")))
(define (create-deployment conn user-id instance-id) (define (create-deployment conn user-id instance-id)
(value-at (value-at
(query conn (query conn
@@ -414,6 +417,7 @@ where usa.user_id=$1 and usa.instance_id=$2;"
(volume-create . "terraform_volume_create") (volume-create . "terraform_volume_create")
(volume-destroy . "terraform_volume_destroy") (volume-destroy . "terraform_volume_destroy")
(instance-backup . "instance_backup") (instance-backup . "instance_backup")
(instance-up . "instance_up")
(status . "status") (status . "status")
(id . "id") (id . "id")
(instance-id . "instance_id"))) (instance-id . "instance_id")))
@@ -657,7 +661,10 @@ where user_id=$1;"
(4 . "fixing-app-normalization") (4 . "fixing-app-normalization")
(5 . "adding-wordpress-app") (5 . "adding-wordpress-app")
(6 . "adding-lldap-app") (6 . "adding-lldap-app")
(7 . "adding-authelia-app"))) (7 . "adding-authelia-app")
(8 . "adding-backblaze-bucket-name-and-id")
(9 . "extend-deployment-status-add-ignored")
(10 . "adding-deployments-instance-up")))
(define (run-pending-migrations conn) (define (run-pending-migrations conn)
(let* ((migration-ids (sort (map car *migrations*) <)) (let* ((migration-ids (sort (map car *migrations*) <))

View File

@@ -0,0 +1 @@
alter table deployments add instance_up deployment_status not null default 'queued';

View File

@@ -0,0 +1,2 @@
alter table user_service_configs add backblaze_bucket_name_enc varchar(255);
alter table user_service_configs add backblaze_bucket_id_enc varchar(255);

View File

@@ -0,0 +1 @@
alter type deployment_status add value 'ignored';

View File

@@ -54,7 +54,8 @@
spiffy spiffy
hmac hmac
sha256-primitive sha256-primitive
string-hexadecimal) string-hexadecimal
base64)
(define app (schematra/make-app)) (define app (schematra/make-app))
@@ -656,6 +657,107 @@ h1, h2, h3, h4, h5, h6 {
(email . ,email)))))))) (email . ,email))))))))
read-json))) read-json)))
;; returns something like:
;; ((accountId . "xxx") (apiInfo (storageApi (absoluteMinimumPartSize . 5000000) (allowed (buckets . #(((id . "yyy") (name . "aaa")))) (capabilities . #("readBucketEncryption" "listFiles" "shareFiles" "listBuckets" "readBucketLifecycleRules" "readBuckets" "readFiles" "writeBucketReplications" "writeBucketNotifications" "listAllBucketNames" "writeFiles" "writeBuckets" "writeBucketEncryption" "deleteFiles" "writeBucketLogging" "readBucketLogging" "readBucketReplications" "writeBucketLifecycleRules" "readBucketNotifications")) (namePrefix . null)) (apiUrl . "https://api004.backblazeb2.com") (downloadUrl . "https://f004.backblazeb2.com") (recommendedPartSize . 100000000) (s3ApiUrl . "https://s3.us-west-004.backblazeb2.com"))) (applicationKeyExpirationTimestamp . null) (authorizationToken . "abc"))
;; #<URI-common: scheme=https port=443 host="api.backblazeb2.com" path=(/ "b2api" "v4" "b2_authorize_account") query=() fragment=#f>
;; #<intarweb#response>
;; ; 3 values
(define (b2-authorize-account key-id key)
(with-input-from-request
(make-request method: 'GET
uri: (uri-reference "https://api.backblazeb2.com/b2api/v4/b2_authorize_account")
headers: (headers `((authorization #(,(string-append "Basic " (base64-encode (string-append key-id ":" key))) raw)))))
#f
read-json))
;; request response looks like
;; (((accountId . "xxx") (bucketId . "xxx") (bucketInfo) (bucketName . "xxx") (bucketType . "allPrivate") (corsRules) (defaultServerSideEncryption (isClientAuthorizedToRead . #t) (value (algorithm . null) (mode . null))) (fileLockConfiguration (isClientAuthorizedToRead . #t) (value (defaultRetention (mode . null) (period . null)) (isFileLockEnabled . #f))) (lifecycleRules ((daysFromHidingToDeleting . 1) (daysFromStartingToCancelingUnfinishedLargeFiles . null) (daysFromUploadingToHiding . null) (fileNamePrefix . ""))) (options "s3") (replicationConfiguration (isClientAuthorizedToRead . #t) (value . null)) (revision . 3)) ((accountId . "yyy") (bucketId . "yyy") (bucketInfo) (bucketName . "yyy") (bucketType . "allPrivate") (corsRules) (defaultServerSideEncryption (isClientAuthorizedToRead . #t) (value (algorithm . null) (mode . null))) (fileLockConfiguration (isClientAuthorizedToRead . #t) (value (defaultRetention (mode . null) (period . null)) (isFileLockEnabled . #f))) (lifecycleRules ((daysFromHidingToDeleting . 1) (daysFromStartingToCancelingUnfinishedLargeFiles . null) (daysFromUploadingToHiding . null) (fileNamePrefix . ""))) (options "s3") (replicationConfiguration (isClientAuthorizedToRead . #t) (value . null)) (revision . 3)))
(define (b2-list-buckets api-url account-token account-id)
(with-input-from-request
(make-request method: 'POST
uri: (uri-reference (string-append api-url "/b2api/v4/b2_list_buckets"))
headers: (headers `((authorization #(,account-token raw))
(content-type application/json))))
(lambda ()
(write-json
`((accountId . ,account-id))))
read-json))
;; a convenience method used to retrieve the buckets either
;; from the key details or via b2-list-buckets.
;; depending on the key config and permissions the way you
;; access the list of buckets you can access will vary
(define (b2-account-buckets key-id key)
(let* ((auth (b2-authorize-account key-id key))
(authorization-token (alist-ref 'authorizationToken auth))
(account-id (alist-ref 'accountId auth))
(api-url (alist-ref 'apiUrl (alist-ref 'storageApi (alist-ref 'apiInfo auth))))
(buckets (alist-ref 'buckets (alist-ref 'allowed (alist-ref 'storageApi (alist-ref 'apiInfo auth)))))
(listed-buckets (and (eq? buckets 'null) ;; if the key does not contain a bucket restriction it should be able to use the api to list buckets
(alist-ref 'buckets (b2-list-buckets api-url authorization-token account-id)))))
(if listed-buckets
(map (lambda (bucket-info)
`((name . ,(alist-ref 'bucketName bucket-info))
(id . ,(alist-ref 'bucketId bucket-info))))
listed-buckets)
(map (lambda (bucket-info)
`((name . ,(alist-ref 'name bucket-info))
(id . ,(alist-ref 'id bucket-info))))
buckets))))
(define (b2-authorization-details key-id key bucket-name)
(let* ((auth (b2-authorize-account key-id key))
(authorization-token (alist-ref 'authorizationToken auth))
(account-id (alist-ref 'accountId auth))
(api-url (alist-ref 'apiUrl (alist-ref 'storageApi (alist-ref 'apiInfo auth))))
(buckets (alist-ref 'buckets (alist-ref 'allowed (alist-ref 'storageApi (alist-ref 'apiInfo auth)))))
(listed-bucket-id (and (eq? buckets 'null) ;; if the key does not contain a bucket restriction it should be able to use the api to list buckets
(alist-ref 'bucketId ;; TODO handle the bucket not being found
(find (lambda (x) (string=? (alist-ref 'bucketName x) bucket-name))
(alist-ref 'buckets (b2-list-buckets api-url authorization-token account-id)))))))
(values authorization-token
account-id
api-url
(or listed-bucket-id (alist-ref 'id (car buckets))) ;; assume at least one bucket and the one we want for now, TODO handle better
buckets)))
(define (b2-list-file-versions api-url account-token bucket-id)
(with-input-from-request
(make-request method: 'GET
uri: (uri-reference (string-append api-url "/b2api/v4/b2_list_file_versions?bucketId=" bucket-id))
headers: (headers `((authorization #(,account-token raw))
(content-type application/json))))
#f
read-json))
(define (b2-list-file-versions-only-name-id api-url account-token bucket-id)
(map (lambda (x)
(cons (alist-ref 'fileName x)
(alist-ref 'fileId x)))
(alist-ref 'files (b2-list-file-versions api-url account-token bucket-id))))
(define (b2-delete-file-version api-url account-token file-name file-id)
(with-input-from-request
(make-request method: 'POST
uri: (uri-reference (string-append api-url "/b2api/v4/b2_delete_file_version"))
headers: (headers `((authorization #(,account-token raw))
(content-type application/json))))
(lambda ()
(write-json
`((fileName . ,file-name)
(fileId . ,file-id))))
read-json))
(define (b2-delete-bucket-files key-id app-key bucket-name)
(receive (token account-id api-url bucket-id _)
(b2-authorization-details key-id app-key bucket-name)
(let loop ((files (b2-list-file-versions-only-name-id api-url token bucket-id)))
(when (not (null? files))
(for-each (lambda (file)
(b2-delete-file-version api-url token (car file) (cdr file)))
files)
(loop (b2-list-file-versions-only-name-id api-url token bucket-id))))))
(define (get-digital-ocean-regions api-token) (define (get-digital-ocean-regions api-token)
(filter (filter
(lambda (r) (lambda (r)
@@ -755,67 +857,49 @@ h1, h2, h3, h4, h5, h6 {
`((success . #f) `((success . #f)
(errors ((message . ,(alist-ref 'message res))))))))) (errors ((message . ,(alist-ref 'message res)))))))))
(define (test-backblaze-connection user-id instance-id key-id application-key bucket-url) (define (test-backblaze-connection key-id application-key)
(let* ((password-path (conc "restic-password-" user-id "-" instance-id)) (handle-exceptions
(restic-password exn
(with-db/transaction `((success . #f)
(lambda (db) (errors ((message . ,(alist-ref 'code (read-json (get-condition-property exn 'client-error 'body)))))))
(get-instance-restic-password db user-id instance-id))))) (receive (data request-uri response) (b2-authorize-account key-id application-key)
(dynamic-wind (if (alist-ref 'authorizationToken data)
(lambda () `((success . #t)
(with-output-to-file password-path (lambda () (display restic-password)))) (result ,data))
(lambda () `((success . #f)
;; restic retries (indefinitely?) if the connection can't be made so (result ,data))))))
;; we pass it through timeout to ensure it does not hang
(receive (in-port out-port pid err-port) (define *instance-up-timeout* 1) ;; seconds
(cond-expand (define *instance-up-retry-time* 120) ;; 120s, 2 minutes
(dev (define *instance-up-retries* (/ *instance-up-retry-time* *instance-up-timeout*))
(process* "timeout" `("--preserve-status" "8s" "docker" "run" "--rm" "--volume" (define (instance-up? path)
,(conc (current-directory) "/" password-path ":/restic-password") (let loop ((i 0))
"-e" ,(conc "AWS_ACCESS_KEY_ID=" key-id)
"-e" ,(conc "AWS_SECRET_ACCESS_KEY=" application-key)
"-i" "restic/restic:0.18.0" "cat" "config"
"--repo" ,(conc "s3:" bucket-url)
"--password-file" "/restic-password"
"--json")))
(else
(process* "/bin/timeout"
`("--preserve-status" "8s" "/bin/restic" "cat" "config"
"--repo" ,(conc "s3:" bucket-url)
"--password-file" ,(conc (current-directory) "/" password-path)
"--json")
`(("AWS_ACCESS_KEY_ID" . ,key-id)
("AWS_SECRET_ACCESS_KEY" . ,application-key)))))
(let ((thread (let ((thread
(thread-start! (thread-start!
(lambda () (lambda ()
(let loop ((i 0)) (condition-case
(thread-sleep! 1) (receive (data uri response) (with-input-from-request path #f read-string)
;; We do a non-blocking wait here so that we don't (if (eq? (response-code response) 401)
;; block the entire web process. #t
(receive (wait-pid exit-normal status) (process-wait pid #t) (begin (thread-sleep! *instance-up-timeout*) ;; we depend on this taking at least as long as the timeout if the instance is still booting
(if (= wait-pid 0) ;; wait-pid is 0 until the process has finished #f)))
(if (< i 12) ;; 12s timeout (e (exn client-error)
(if (eq? (response-code (get-condition-property e 'client-error 'response)) 401)
#t
(begin (thread-sleep! *instance-up-timeout*) ;; we depend on this taking at least as long as the timeout if the instance is still booting
#f)))
(e (exn net)
(thread-sleep! *instance-up-timeout*)
#f)
(e ()
(thread-sleep! *instance-up-timeout*)
#f))))))
(if (thread-join! thread *instance-up-timeout* #f)
#t
(if (< i *instance-up-retries*)
(loop (+ i 1)) (loop (+ i 1))
`((success . #f) #f)))))
(errors ((message . "timeout trying to connect to backblaze")))))
(if exit-normal
(let ((res (with-input-from-port in-port read-json))
(err (with-input-from-port err-port read-json)))
;; status 10 is what is returned if we can connect but the repo
;; is not initialized yet
(if (or res (and err (= status 10)))
`((success . #t)
(result . ,res))
`((success . #f)
(errors ((message . "abnormal exit - check Key ID, Application ID, and Bucket URL"))))))
`((success . #f)
(errors ((message . "abnormal exit - check Key ID, Application ID, and Bucket URL"))))
))))))))
(thread-join! thread))))
(lambda ()
(handle-exceptions exn 'ignore
(delete-file password-path))))))
(define (deployment-directory user-id instance-id) (define (deployment-directory user-id instance-id)
(string-append "deploy-" (number->string user-id) "-" (->string instance-id))) (string-append "deploy-" (number->string user-id) "-" (->string instance-id)))
@@ -963,6 +1047,34 @@ chmod -R 777 /opt/keys")))
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
64))) 64)))
(define (create-authelia-password-hash password)
;; docker run --rm -it authelia/authelia:latest authelia crypto hash generate argon2
(receive (in-port out-port pid err-port)
(cond-expand
(dev
(process* "docker" `("run" "--rm" "authelia/authelia:latest" "authelia" "crypto" "hash" "generate" "argon2" "--password" ,password)))
(else
(process* "/usr/local/bin/authelia" `("crypto" "hash" "generate" "argon2" "--password" ,password))))
(let ((thread
(thread-start!
(lambda ()
(let loop ()
(thread-sleep! 1)
;; We do a non-blocking wait here so that we don't
;; block the entire web process.
(receive (wait-pid exit-normal status) (process-wait pid #t)
(if (= wait-pid 0) ;; wait-pid is 0 until the process has finished
(loop)
(if exit-normal
(begin
(with-input-from-port err-port read-string) ;; left here for debugging and to clear ports
;; the output is prefixed with "Digest: " and suffixed with a newline
;; so we clean it up
(string-drop (string-trim-right (with-input-from-port in-port read-string)) 8))
(begin (log-to (debug-log) "authelia: docker command error")
(error "Authelia for generating password hash had abnormal exit"))))))))))
(thread-join! thread))))
(define (generate-postgres-password) (define (generate-postgres-password)
(generator->string (gtake (make-random-char-generator (generator->string (gtake (make-random-char-generator
"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789") "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789")
@@ -1139,9 +1251,7 @@ chmod -R 777 /opt/keys")))
(type "password") (type "password")
(value ,(alist-ref 'backblaze-application-key config)))) (value ,(alist-ref 'backblaze-application-key config))))
(Field (@ (name "backblaze-key-id") (label ("Key ID")) (type "password") (Field (@ (name "backblaze-key-id") (label ("Key ID")) (type "password")
(value ,(alist-ref 'backblaze-key-id config)))) (value ,(alist-ref 'backblaze-key-id config)))))
(Field (@ (name "backblaze-bucket-url") (label ("Bucket URL")) (type "password")
(value ,(alist-ref 'backblaze-bucket-url config)))))
(Form-Nav))))))) (Form-Nav)))))))
(post "/config/wizard/services-submit/:id" (post "/config/wizard/services-submit/:id"
@@ -1157,8 +1267,7 @@ chmod -R 777 /opt/keys")))
(cloudflare-zone-id . ,(alist-ref 'cloudflare-zone-id (current-params))) (cloudflare-zone-id . ,(alist-ref 'cloudflare-zone-id (current-params)))
(digitalocean-api-token . ,(alist-ref 'digitalocean-api-token (current-params))) (digitalocean-api-token . ,(alist-ref 'digitalocean-api-token (current-params)))
(backblaze-application-key . ,(alist-ref 'backblaze-application-key (current-params))) (backblaze-application-key . ,(alist-ref 'backblaze-application-key (current-params)))
(backblaze-key-id . ,(alist-ref 'backblaze-key-id (current-params))) (backblaze-key-id . ,(alist-ref 'backblaze-key-id (current-params)))))))
(backblaze-bucket-url . ,(alist-ref 'backblaze-bucket-url (current-params)))))))
(redirect (conc "/config/wizard/services-success/" instance-id)))) (redirect (conc "/config/wizard/services-success/" instance-id))))
(get/widgets (get/widgets
@@ -1172,10 +1281,8 @@ chmod -R 777 /opt/keys")))
(alist-ref 'cloudflare-zone-id service-config) (alist-ref 'cloudflare-zone-id service-config)
(alist-ref 'cloudflare-account-id service-config))) (alist-ref 'cloudflare-account-id service-config)))
(digitalocean-result (test-digitalocean-connection (alist-ref 'digitalocean-api-token service-config))) (digitalocean-result (test-digitalocean-connection (alist-ref 'digitalocean-api-token service-config)))
(backblaze-result (test-backblaze-connection (session-user-id) instance-id (backblaze-result (test-backblaze-connection (alist-ref 'backblaze-key-id service-config)
(alist-ref 'backblaze-key-id service-config) (alist-ref 'backblaze-application-key service-config))))
(alist-ref 'backblaze-application-key service-config)
(alist-ref 'backblaze-bucket-url service-config))))
`(App `(App
(Configuration-Wizard (Configuration-Wizard
(@ (step "Services")) (@ (step "Services"))
@@ -1237,7 +1344,17 @@ chmod -R 777 /opt/keys")))
(filter cdr (filter cdr
(get-user-selected-apps db (session-user-id) instance-id)))) (get-user-selected-apps db (session-user-id) instance-id))))
(app-config . ,(get-user-app-config db (session-user-id) instance-id)) (app-config . ,(get-user-app-config db (session-user-id) instance-id))
(service-config . ,(get-user-service-config db (session-user-id) instance-id))))))) (service-config . ,(get-user-service-config db (session-user-id) instance-id))))))
(backblaze-buckets (b2-account-buckets (alist-ref 'backblaze-key-id (alist-ref 'service-config results))
(alist-ref 'backblaze-application-key (alist-ref 'service-config results))))
(backblaze-s3-api-url (alist-ref
's3ApiUrl
(alist-ref
'storageApi
(alist-ref
'apiInfo
(b2-authorize-account (alist-ref 'backblaze-key-id (alist-ref 'service-config results))
(alist-ref 'backblaze-application-key (alist-ref 'service-config results))))))))
`(App `(App
(Configuration-Wizard (Configuration-Wizard
(@ (step "Apps")) (@ (step "Apps"))
@@ -1249,14 +1366,27 @@ chmod -R 777 /opt/keys")))
(Field (@ (element select) (name "root-domain")) (Field (@ (element select) (name "root-domain"))
,@(map (lambda (domain) ,@(map (lambda (domain)
`(option (@ (value ,domain) `(option (@ (value ,domain)
(required #t)
,@(if (equal? domain ,@(if (equal? domain
(alist-ref 'root-domain (alist-ref 'app-config results))) (alist-ref 'root-domain (alist-ref 'app-config results)))
'(selected) '(selected)
'())) '()))
,domain)) ,domain))
(get-cloudflare-domains (alist-ref 'cloudflare-api-token (get-cloudflare-domains (alist-ref 'cloudflare-api-token
(alist-ref 'service-config results)))) (alist-ref 'service-config results))))))
)) (Fieldset
(@ (title "Backblaze Bucket"))
(Field (@ (element select) (name "backblaze-bucket-id"))
,@(map (lambda (bucket)
`(option (@ (value ,(string-append (alist-ref 'id bucket) "|" (alist-ref 'name bucket)))
(required #t)
,@(if (equal? (alist-ref 'id bucket)
(alist-ref 'backblaze-bucket-id (alist-ref 'service-config results)))
'(selected)
'()))
,(alist-ref 'name bucket)))
backblaze-buckets)))
(input (@ (type "hidden") (name "backblaze-s3-url") (value ,backblaze-s3-api-url)))
(Fieldset (Fieldset
(@ (title "Selected Apps")) (@ (title "Selected Apps"))
(Field (@ (name "wg-easy") (type "checkbox") (label ("WG Easy")) (checked ,(member 'wg-easy (alist-ref 'selected-apps results))))) (Field (@ (name "wg-easy") (type "checkbox") (label ("WG Easy")) (checked ,(member 'wg-easy (alist-ref 'selected-apps results)))))
@@ -1269,14 +1399,18 @@ chmod -R 777 /opt/keys")))
'())) '()))
(Field (@ (name "wordpress") (type "checkbox") (label ("Wordpress")) (checked ,(member 'wordpress (alist-ref 'selected-apps results))))) (Field (@ (name "wordpress") (type "checkbox") (label ("Wordpress")) (checked ,(member 'wordpress (alist-ref 'selected-apps results)))))
(Field (@ (name "log-viewer") (type "checkbox") (label ("Log Viewer")) (checked #t) (disabled "disabled"))) (Field (@ (name "log-viewer") (type "checkbox") (label ("Log Viewer")) (checked #t) (disabled "disabled")))
(Field (@ (name "lldap") (type "checkbox") (label ("Admin LLDAP")) (checked #t) (disabled "disabled"))) ;; (Field (@ (name "lldap") (type "checkbox") (label ("Admin LLDAP")) (checked #t) (disabled "disabled")))
(Field (@ (name "authelia") (type "checkbox") (label ("Admin Authelia")) (checked #t) (disabled "disabled")))) ;; (Field (@ (name "authelia") (type "checkbox") (label ("Admin Authelia")) (checked #t) (disabled "disabled")))
)
;; TODO add config for when automatic upgrades are scheduled for? ;; TODO add config for when automatic upgrades are scheduled for?
;; TODO add config for server timezone? ;; TODO add config for server timezone?
(Form-Nav (@ (back-to ,(conc "/config/wizard/services-success/" instance-id)))))))))) (Form-Nav (@ (back-to ,(conc "/config/wizard/services-success/" instance-id))))))))))
(post "/config/wizard/apps-submit/:id" (post "/config/wizard/apps-submit/:id"
(let ((instance-id (alist-ref "id" (current-params) equal?))) (let* ((instance-id (alist-ref "id" (current-params) equal?))
(bucket-values (string-split (alist-ref 'backblaze-bucket-id (current-params)) "|"))
(bucket-name (cadr bucket-values))
(bucket-id (car bucket-values)))
(with-db/transaction (with-db/transaction
(lambda (db) (lambda (db)
(update-user-selected-apps (update-user-selected-apps
@@ -1289,10 +1423,17 @@ chmod -R 777 /opt/keys")))
(ghost . ,(or (and (alist-ref 'ghost (current-params)) "6") #f)) (ghost . ,(or (and (alist-ref 'ghost (current-params)) "6") #f))
(nassella . ,(or (and (alist-ref 'nassella (current-params)) "b0.0.1") #f)) (nassella . ,(or (and (alist-ref 'nassella (current-params)) "b0.0.1") #f))
(wordpress . ,(or (and (alist-ref 'wordpress (current-params)) "8.4") #f)) (wordpress . ,(or (and (alist-ref 'wordpress (current-params)) "8.4") #f))
(lldap . "0.6.3") (lldap . #f) ;; "0.6.3"
(authelia . "4") (authelia . "4")
(instance-control . "b0.0.1") (instance-control . "b0.0.1")
(log-viewer . "20")))) (log-viewer . "20"))))
(update-user-service-config
db
(session-user-id)
instance-id
`((backblaze-bucket-name . ,bucket-name)
(backblaze-bucket-id . ,bucket-id)
(backblaze-bucket-url . ,(string-append (alist-ref 'backblaze-s3-url (current-params)) "/" bucket-name))))
(update-root-domain db (update-root-domain db
(session-user-id) (session-user-id)
instance-id instance-id
@@ -1358,31 +1499,30 @@ chmod -R 777 /opt/keys")))
(Field (@ (name "wordpress-subdomain") (label ("Subdomain")) (required #t) (Field (@ (name "wordpress-subdomain") (label ("Subdomain")) (required #t)
(value ,(alist-ref 'subdomain (alist-ref 'wordpress app-config eq? '()) eq? "wordpress")))))) (value ,(alist-ref 'subdomain (alist-ref 'wordpress app-config eq? '()) eq? "wordpress"))))))
'()) '())
,@(if (member 'lldap selected-apps) ;; ,@(if (member 'lldap selected-apps)
`((Fieldset ;; `((Fieldset
(@ (title "Admin LLDAP")) ;; (@ (title "Admin LLDAP"))
(Field (@ (name "lldap-subdomain") (label ("Subdomain")) (required #t) ;; (Field (@ (name "lldap-subdomain") (label ("Subdomain")) (required #t)
(value ,(alist-ref 'subdomain (alist-ref 'lldap app-config eq? '()) eq? "lldap")))) ;; (value ,(alist-ref 'subdomain (alist-ref 'lldap app-config eq? '()) eq? "lldap"))))
(Field (@ (name "lldap-user-email") (label ("Admin Email Address")) (type "email") (required #t) ;; (Field (@ (name "lldap-user-email") (label ("Admin Email Address")) (type "email") (required #t)
(value ,(alist-ref 'user-email (alist-ref 'lldap app-config eq? '()) eq? "")))) ;; (value ,(alist-ref 'user-email (alist-ref 'lldap app-config eq? '()) eq? ""))))
(Field (@ (name "lldap-admin-password") (label ("Admin Password")) (type "password") (required #t) ;; (Field (@ (name "lldap-admin-password") (label ("Admin Password")) (type "password") (required #t)
(value ,(alist-ref 'admin-password (alist-ref 'lldap app-config eq? '()) eq? "")))))) ;; (value ,(alist-ref 'admin-password (alist-ref 'lldap app-config eq? '()) eq? ""))))))
'()) ;; '())
,@(if (member 'authelia selected-apps) ;; ,@(if (member 'authelia selected-apps)
`((Fieldset ;; `((Fieldset
(@ (title "Admin Authelia")) ;; (@ (title "Admin Authelia"))
(Field (@ (name "authelia-subdomain") (label ("Subdomain")) (required #t) ;; (Field (@ (name "authelia-subdomain") (label ("Subdomain")) (required #t)
(value ,(alist-ref 'subdomain (alist-ref 'authelia app-config eq? '()) eq? "authelia")))))) ;; (value ,(alist-ref 'subdomain (alist-ref 'authelia app-config eq? '()) eq? "authelia"))))))
'()) ;; '())
(Fieldset (Fieldset
(@ (title "Log Viewer")) (@ (title "Log Viewer"))
(Field (@ (name "log-viewer-subdomain") (label ("Subdomain")) (required #t) (Field (@ (name "log-viewer-subdomain") (label ("Subdomain")) (required #t)
(value ,(alist-ref 'subdomain (alist-ref 'log-viewer app-config eq? '()) eq? "logs")))) (value ,(alist-ref 'subdomain (alist-ref 'log-viewer app-config eq? '()) eq? "logs"))))
;; (Field (@ (name "log-viewer-user") (label ("Username")) (required #t) (Field (@ (name "log-viewer-user") (label ("Admin Email")) (required #t)
;; (value ,(alist-ref 'user (alist-ref 'log-viewer app-config eq? '()) eq? "")))) (value ,(alist-ref 'user (alist-ref 'log-viewer app-config eq? '()) eq? ""))))
;; (Field (@ (name "log-viewer-password") (label ("Password")) (type "password") (required #t) (Field (@ (name "log-viewer-password") (label ("Admin Password")) (type "password") (required #t)
;; (value ,(alist-ref 'password (alist-ref 'log-viewer app-config eq? '()) eq? "")))) (value ,(alist-ref 'password (alist-ref 'log-viewer app-config eq? '()) eq? "")))))
)
,@(if (or (member 'nextcloud selected-apps) (member 'ghost selected-apps) (member 'nassella selected-apps) (member 'authelia selected-apps)) ,@(if (or (member 'nextcloud selected-apps) (member 'ghost selected-apps) (member 'nassella selected-apps) (member 'authelia selected-apps))
`((Fieldset `((Fieldset
(@ (title "All Apps - Email - SMTP")) (@ (title "All Apps - Email - SMTP"))
@@ -1520,8 +1660,8 @@ chmod -R 777 /opt/keys")))
(alist-ref 'authelia config eq? '())) (alist-ref 'authelia config eq? '()))
(generate-authelia-key-seed))))) (generate-authelia-key-seed)))))
(log-viewer . ((subdomain . ,(alist-ref 'log-viewer-subdomain (current-params))) (log-viewer . ((subdomain . ,(alist-ref 'log-viewer-subdomain (current-params)))
(user . "unused") ;; TODO can we remove? (user . ,(alist-ref 'log-viewer-user (current-params)))
(password . "unused"))) ;; TODO can we remove? (password . ,(alist-ref 'log-viewer-password (current-params)))))
(all-apps . ((smtp-host . ,(alist-ref 'smtp-host (current-params))) (all-apps . ((smtp-host . ,(alist-ref 'smtp-host (current-params)))
(smtp-port . ,(alist-ref 'smtp-port (current-params))) (smtp-port . ,(alist-ref 'smtp-port (current-params)))
(smtp-auth-user . ,(alist-ref 'smtp-auth-user (current-params))) (smtp-auth-user . ,(alist-ref 'smtp-auth-user (current-params)))
@@ -1685,7 +1825,6 @@ chmod -R 777 /opt/keys")))
(restic-password (alist-ref 'restic-password results)) (restic-password (alist-ref 'restic-password results))
(dir (deployment-directory (session-user-id) instance-id))) (dir (deployment-directory (session-user-id) instance-id)))
(setup-deploy-files dir (alist-ref 'state terraform-state) (alist-ref 'backup terraform-state)) (setup-deploy-files dir (alist-ref 'state terraform-state) (alist-ref 'backup terraform-state))
(log-to (debug-log) "writing configs")
(with-output-to-file (string-append dir "/config/apps.config") (with-output-to-file (string-append dir "/config/apps.config")
(lambda () (lambda ()
(map (lambda (e) (map (lambda (e)
@@ -1695,13 +1834,14 @@ chmod -R 777 /opt/keys")))
(map (lambda (app-version) (map (lambda (app-version)
(conc (if (eq? (car app-version) 'log-viewer) 'dozzle (car app-version)) (conc (if (eq? (car app-version) 'log-viewer) 'dozzle (car app-version))
"," ","
(alist-ref 'subdomain (alist-ref (car app-version) config)) (or (alist-ref 'subdomain (alist-ref (car app-version) config))
"nassella-ignore") ;; a hack to get authelia to work for now
"," ","
(cdr app-version))) (cdr app-version)))
selected-apps) selected-apps)
" ")) " "))
("HOST_ADMIN_USER" . ,(alist-ref 'user (alist-ref 'log-viewer config))) ("HOST_ADMIN_USER" . ,(alist-ref 'user (alist-ref 'log-viewer config)))
("HOST_ADMIN_PASSWORD" . ,(alist-ref 'password (alist-ref 'log-viewer config))) ("HOST_ADMIN_PASSWORD" . ,(create-authelia-password-hash (alist-ref 'password (alist-ref 'log-viewer config))))
("NEXTCLOUD_ADMIN_USER" . ,(alist-ref 'admin-user (alist-ref 'nextcloud config))) ("NEXTCLOUD_ADMIN_USER" . ,(alist-ref 'admin-user (alist-ref 'nextcloud config)))
("NEXTCLOUD_ADMIN_PASSWORD" . ,(alist-ref 'admin-password (alist-ref 'nextcloud config))) ("NEXTCLOUD_ADMIN_PASSWORD" . ,(alist-ref 'admin-password (alist-ref 'nextcloud config)))
("NEXTCLOUD_POSTGRES_DB" . "nextcloud") ("NEXTCLOUD_POSTGRES_DB" . "nextcloud")
@@ -1774,13 +1914,21 @@ chmod -R 777 /opt/keys")))
(with-db/transaction (with-db/transaction
(lambda (db) (lambda (db)
(get-user-app-config db (session-user-id) instance-id)))) (get-user-app-config db (session-user-id) instance-id))))
(first-deployment? (not (with-db/transaction (lambda (db) (get-most-recent-deployment-status db user-id instance-id)))))
(deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id)))) (deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id))))
(dir (deployment-directory user-id instance-id)) (dir (deployment-directory user-id instance-id))
(backup-request-id (conc (truncate (time->seconds (current-time))) "-" (pseudo-random-integer 10000)))) (backup-request-id (conc (truncate (time->seconds (current-time))) "-" (pseudo-random-integer 10000))))
(if first-deployment?
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id '((instance-backup . ignored)
(machine-destroy . ignored)
(ip-destroy . ignored)
(volume-destroy . ignored)))))
(begin
(with-db/transaction (with-db/transaction
(lambda (db) (lambda (db)
(update-deployment-progress db deployment-id '((instance-backup . in-progress))))) (update-deployment-progress db deployment-id '((instance-backup . in-progress)))))
;; ;; TODO does this handle new deployments? We should not do a back up if this is new!
(handle-exceptions (handle-exceptions
exn exn
(with-db/transaction (with-db/transaction
@@ -1795,9 +1943,10 @@ chmod -R 777 /opt/keys")))
(tag . "automated_pre_instance_update") (tag . "automated_pre_instance_update")
;; effectively a guid, we just want something unique ;; effectively a guid, we just want something unique
(request_id . ,backup-request-id) (request_id . ,backup-request-id)
(version . 0)))) (version . 0))))))
(thread-start! (thread-start!
(lambda () (lambda ()
(when (not first-deployment?)
(let ((start-time (time->seconds (current-time)))) (let ((start-time (time->seconds (current-time))))
(let loop () (let loop ()
(thread-sleep! 1) (thread-sleep! 1)
@@ -1817,7 +1966,7 @@ chmod -R 777 /opt/keys")))
(with-db/transaction (with-db/transaction
(lambda (db) (lambda (db)
(update-deployment-progress db deployment-id `((instance-backup . ,(or (and complete 'complete) 'failed)))))) (update-deployment-progress db deployment-id `((instance-backup . ,(or (and complete 'complete) 'failed))))))
(loop))))) (loop))))))
(change-directory dir) (change-directory dir)
(let ((pid (process-run "make preapply && make apply > make-out 2>&1"))) (let ((pid (process-run "make preapply && make apply > make-out 2>&1")))
(with-db/transaction (lambda (db) (update-deployment-in-progress db deployment-id pid))) (with-db/transaction (lambda (db) (update-deployment-in-progress db deployment-id pid)))
@@ -1849,13 +1998,29 @@ chmod -R 777 /opt/keys")))
(with-db/transaction (with-db/transaction
(lambda (db) (lambda (db)
(update-deployment-progress db deployment-id progress) (update-deployment-progress db deployment-id progress)
(update-deployment-status
db user-id deployment-id
(if (= status 0) 'complete 'failed)
(with-input-from-file (string-append dir "/make-out") read-string))
(update-user-terraform-state db user-id instance-id (update-user-terraform-state db user-id instance-id
(if (eof-object? tf-state) "" tf-state) (if (eof-object? tf-state) "" tf-state)
(if (eof-object? tf-state-backup) "" tf-state-backup)))))))))))))) (if (eof-object? tf-state-backup) "" tf-state-backup))
(if (= status 0)
(update-deployment-progress db deployment-id `((instance-up . in-progress)))
(update-deployment-status
db user-id deployment-id
'failed
(with-input-from-file (string-append dir "/make-out") read-string)))))
(when (= status 0)
(let ((instance-up (instance-up? (string-append "https://"
(alist-ref 'subdomain (alist-ref 'log-viewer (alist-ref 'config app-config)))
"."
(alist-ref 'root-domain app-config)))))
(with-db/transaction
(lambda (db)
(update-deployment-progress db deployment-id `((instance-up . ,(if instance-up 'complete 'failed))))
(update-deployment-status
db user-id deployment-id
(if instance-up
'complete
'failed)
(with-input-from-file (string-append dir "/make-out") read-string))))))))))))))))
(redirect (conc "/config/wizard/success/" (alist-ref "id" (current-params) equal?)))) (redirect (conc "/config/wizard/success/" (alist-ref "id" (current-params) equal?))))
(get/widgets (get/widgets
@@ -1893,10 +2058,12 @@ chmod -R 777 /opt/keys")))
((complete) "Complete!") ((complete) "Complete!")
((failed) "Failed")))) ((failed) "Failed"))))
(ul ,@(map (lambda (x) (ul ,@(map (lambda (x)
`(li (HStack (@ (style ((align-items "center") (if (eq? (alist-ref (car x) progress) 'ignored)
'()
`((li (HStack (@ (style ((align-items "center")
(margin-bottom ,($ 'gap.gutter))))) (margin-bottom ,($ 'gap.gutter)))))
(Deployment-Status-Pill (@ (status ,(alist-ref (car x) progress)))) (Deployment-Status-Pill (@ (status ,(alist-ref (car x) progress))))
,(cdr x)))) ,(cdr x))))))
'((instance-backup . "Backup Instance") '((instance-backup . "Backup Instance")
(generate-configs . "Generate Custom Image") (generate-configs . "Generate Custom Image")
(custom-image . "Upload Flatcar Image") (custom-image . "Upload Flatcar Image")
@@ -1905,7 +2072,8 @@ chmod -R 777 /opt/keys")))
(ip-destroy . "Instance Mapped IP Disconnect") (ip-destroy . "Instance Mapped IP Disconnect")
(ip-create . "Instance Mapped IP Connect") (ip-create . "Instance Mapped IP Connect")
(volume-create . "App Volume Connect") (volume-create . "App Volume Connect")
(machine-destroy . "Cleanup Previous Instance")))) (machine-destroy . "Cleanup Previous Instance")
(instance-up . "Instance Starting Up"))))
(form (form
(@ (action "/dashboard") (method GET)) (@ (action "/dashboard") (method GET))
,@(if (or (eq? (string->symbol status) 'complete) (eq? (string->symbol status) 'failed)) ,@(if (or (eq? (string->symbol status) 'complete) (eq? (string->symbol status) 'failed))
@@ -1929,7 +2097,7 @@ chmod -R 777 /opt/keys")))
(define (instance-status->pill-type status) (define (instance-status->pill-type status)
(case (string->symbol status) (case (string->symbol status)
((queued) 'info) ((queued) 'info)
((in-progress 'warning)) ((in-progress) 'warning)
((complete) 'safe) ((complete) 'safe)
((failed) 'alert) ((failed) 'alert)
(else 'alert))) (else 'alert)))
@@ -1989,8 +2157,8 @@ chmod -R 777 /opt/keys")))
(h3 "Apps") (h3 "Apps")
(ul ,@(map (lambda (app-info) (ul ,@(map (lambda (app-info)
(let ((app (alist-ref 'app-name app-info))) (let ((app (alist-ref 'app-name app-info)))
`((li (a (@ (href "#") (style ((color ,($ 'color.primary.background-contrast))))) ,app) ;; TODO documentation URL `((li ;; (a (@ (href "#") (style ((color ,($ 'color.primary.background-contrast))))) ,app)
" (v" ,(alist-ref 'installed-version app-info) ") " (h4 ,app " (v" ,(alist-ref 'installed-version app-info) ") ")
(a (@ (href "https://" (a (@ (href "https://"
,(alist-ref 'subdomain (alist-ref app config)) ,(alist-ref 'subdomain (alist-ref app config))
"." ,root-domain) "." ,root-domain)
@@ -2058,20 +2226,27 @@ chmod -R 777 /opt/keys")))
(@ (action ,(conc "/destroy-submit/" instance-id)) (method POST)) (@ (action ,(conc "/destroy-submit/" instance-id)) (method POST))
(VStack (VStack
(Fieldset (Fieldset
(@ (title "Type the domain name of the instance to confirm.")) (@ (title "Delete Instance"))
(Field (@ (name "instance-domain") (label ("Domain")) (value "")))) (Field (@ (name "instance-domain") (label ("Type the domain name of the instance to confirm.")) (value "")))
(Field (@ (name "delete-backups") (label ("Delete backups for this instance")) (type "checkbox"))))
(input (@ (type "hidden") (value ,(alist-ref 'force (current-params))) (name "force")))
(Form-Nav (@ (back-to "/dashboard") (submit-button "Destroy")))))))) (Form-Nav (@ (back-to "/dashboard") (submit-button "Destroy"))))))))
;; TODO This is mostly a copy of the deployment POST action
(post "/destroy-submit/:id" (post "/destroy-submit/:id"
(let* ((instance-id (alist-ref "id" (current-params) equal?)) (let* ((instance-id (alist-ref "id" (current-params) equal?))
(status (string->symbol
(->string
(with-db/transaction
(lambda (db)
(get-most-recent-deployment-status db (session-user-id) instance-id)))))))
(if (or (not (or (eq? status 'queued) (eq? status 'in-progress)))
(equal? (alist-ref 'force (current-params)) "true"))
(let* ((instance-id (alist-ref "id" (current-params) equal?))
(restic-snapshot-id (alist-ref 'restic-snapshot-id (current-params)))
(results (results
(with-db/transaction (with-db/transaction
(lambda (db) (lambda (db)
`((selected-apps . ,(map `((selected-apps . ,(get-user-selected-apps db (session-user-id) instance-id))
car
(filter cdr
(get-user-selected-apps db (session-user-id) instance-id))))
(app-config . ,(get-user-app-config db (session-user-id) instance-id)) (app-config . ,(get-user-app-config db (session-user-id) instance-id))
(service-config . ,(get-user-service-config db (session-user-id) instance-id)) (service-config . ,(get-user-service-config db (session-user-id) instance-id))
(terraform-state . ,(get-user-terraform-state db (session-user-id) instance-id)) (terraform-state . ,(get-user-terraform-state db (session-user-id) instance-id))
@@ -2172,11 +2347,13 @@ chmod -R 777 /opt/keys")))
("flatcar_stable_version" . "4593.2.4"))) ("flatcar_stable_version" . "4593.2.4")))
;; remove the newline that generating the ssh key adds ;; remove the newline that generating the ssh key adds
(display "ssh_keys=[\"") (display (string-drop-right ssh-pub-key 1)) (print "\"]"))) (display "ssh_keys=[\"") (display (string-drop-right ssh-pub-key 1)) (print "\"]")))
;; TODO need a new table to track destroying?
;; as this is creating a new "deployment"
;; to attach state to
(let* ((instance-id (alist-ref "id" (current-params) equal?)) (let* ((instance-id (alist-ref "id" (current-params) equal?))
(delete-backups (alist-ref 'delete-backups (current-params) equal?))
(user-id (session-user-id)) (user-id (session-user-id))
(app-config
(with-db/transaction
(lambda (db)
(get-user-app-config db (session-user-id) instance-id))))
(deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id)))) (deployment-id (with-db/transaction (lambda (db) (create-deployment db user-id instance-id))))
(dir (deployment-directory user-id instance-id))) (dir (deployment-directory user-id instance-id)))
(thread-start! (thread-start!
@@ -2212,16 +2389,29 @@ chmod -R 777 /opt/keys")))
(with-db/transaction (with-db/transaction
(lambda (db) (lambda (db)
(update-deployment-progress db deployment-id progress) (update-deployment-progress db deployment-id progress)
(when (= status 0)
(update-deployment-status (update-deployment-status
db user-id deployment-id db user-id deployment-id
(if exit-normal 'complete 'failed) 'failed
(with-input-from-file (string-append dir "/make-out") read-string)) (with-input-from-file (string-append dir "/make-out") read-string)))
(update-user-terraform-state db user-id instance-id (update-user-terraform-state db user-id instance-id
(if (eof-object? tf-state) "" tf-state) (if (eof-object? tf-state) "" tf-state)
(if (eof-object? tf-state-backup) "" tf-state-backup)) (if (eof-object? tf-state-backup) "" tf-state-backup))))
(when exit-normal ;; todo handle errors here
(destroy-instance db instance-id)))))))))))) (when delete-backups
(redirect (conc "/destroy-success/" (alist-ref "id" (current-params) equal?))))))) (b2-delete-bucket-files (alist-ref 'backblaze-key-id service-config) (alist-ref 'backblaze-application-key service-config)
(last (uri-path (uri-reference (alist-ref 'backblaze-bucket-url service-config))))))
(with-db/transaction
(lambda (db)
(update-deployment-status
db user-id deployment-id
'complete
(with-input-from-file (string-append dir "/make-out") read-string))))
(with-db/transaction
(lambda (db)
(destroy-instance db instance-id)))))))))))
(redirect (conc "/config/wizard/success/" (alist-ref "id" (current-params) equal?))))))
(redirect (conc "/config/wizard/success/" (alist-ref "id" (current-params) equal?))))))
(get/widgets (get/widgets
("/destroy-success/:id" ("/destroy-success/:id"