You've already forked guix-tribes
335 lines
14 KiB
Scheme
335 lines
14 KiB
Scheme
(define-module (tribes services lego)
|
|
#:use-module (gnu packages admin)
|
|
#:use-module (gnu packages tls)
|
|
#:use-module (gnu services)
|
|
#:use-module (gnu services herd)
|
|
#:use-module (gnu services shepherd)
|
|
#:use-module (guix gexp)
|
|
#:use-module (guix records)
|
|
#:use-module (ice-9 match)
|
|
#:use-module (srfi srfi-1)
|
|
#:use-module (srfi srfi-13)
|
|
#:use-module (tribes packages web)
|
|
#:export (lego-certificate-configuration
|
|
lego-certificate-configuration?
|
|
lego-certificate-configuration-name
|
|
lego-certificate-configuration-subjects
|
|
lego-certificate-configuration-email
|
|
lego-certificate-configuration-server
|
|
lego-certificate-configuration-profile
|
|
lego-certificate-configuration-listen-http
|
|
lego-certificate-configuration-webroot
|
|
lego-certificate-configuration-key-type
|
|
lego-certificate-configuration-renew-days
|
|
lego-certificate-configuration-requirement
|
|
lego-certificate-configuration-reload-services
|
|
lego-certificate-directory
|
|
lego-certificate-full-pem
|
|
lego-configuration
|
|
lego-configuration?
|
|
lego-configuration-package
|
|
lego-configuration-renew-hours
|
|
lego-configuration-renew-minutes
|
|
lego-configuration-certificates
|
|
lego-service-type))
|
|
|
|
(define-record-type* <lego-certificate-configuration>
|
|
lego-certificate-configuration make-lego-certificate-configuration
|
|
lego-certificate-configuration?
|
|
(name lego-certificate-configuration-name)
|
|
(subjects lego-certificate-configuration-subjects)
|
|
(email lego-certificate-configuration-email
|
|
(default #f))
|
|
(server lego-certificate-configuration-server
|
|
(default "https://acme-v02.api.letsencrypt.org/directory"))
|
|
(profile lego-certificate-configuration-profile
|
|
(default #f))
|
|
(listen-http lego-certificate-configuration-listen-http
|
|
(default #f))
|
|
(webroot lego-certificate-configuration-webroot
|
|
(default #f))
|
|
(key-type lego-certificate-configuration-key-type
|
|
(default "ec256"))
|
|
(renew-days lego-certificate-configuration-renew-days
|
|
(default #f))
|
|
(requirement lego-certificate-configuration-requirement
|
|
(default '()))
|
|
(reload-services lego-certificate-configuration-reload-services
|
|
(default '())))
|
|
|
|
(define-record-type* <lego-configuration>
|
|
lego-configuration make-lego-configuration
|
|
lego-configuration?
|
|
(package lego-configuration-package
|
|
(default lego))
|
|
(renew-hours lego-configuration-renew-hours
|
|
(default '(0 12)))
|
|
(renew-minutes lego-configuration-renew-minutes
|
|
(default '(17)))
|
|
(certificates lego-configuration-certificates
|
|
(default '())))
|
|
|
|
(define (lego-certificate-directory certificate)
|
|
(string-append "/var/lib/lego/"
|
|
(lego-certificate-configuration-name certificate)))
|
|
|
|
(define (lego-certificate-full-pem certificate)
|
|
(string-append (lego-certificate-directory certificate) "/full.pem"))
|
|
|
|
(define (subject->san-entry subject)
|
|
(if (and (not (string-any char-alphabetic? subject))
|
|
(string-any (lambda (chr)
|
|
(or (char-numeric? chr)
|
|
(char=? chr #\.)
|
|
(char=? chr #\:)))
|
|
subject))
|
|
(string-append "IP:" subject)
|
|
(string-append "DNS:" subject)))
|
|
|
|
(define (ip-subject? subject)
|
|
(and (not (string-any char-alphabetic? subject))
|
|
(string-any (lambda (chr)
|
|
(or (char-numeric? chr)
|
|
(char=? chr #\.)
|
|
(char=? chr #\:)))
|
|
subject)))
|
|
|
|
(define (certificate-key-name certificate)
|
|
(string-map (lambda (chr)
|
|
(if (char=? chr #\*)
|
|
#\_
|
|
chr))
|
|
(car (lego-certificate-configuration-subjects certificate))))
|
|
|
|
(define (lego-common-arguments certificate)
|
|
(let ((listen-http (lego-certificate-configuration-listen-http certificate))
|
|
(webroot (lego-certificate-configuration-webroot certificate))
|
|
(subjects (lego-certificate-configuration-subjects certificate))
|
|
(email (lego-certificate-configuration-email certificate))
|
|
(server (lego-certificate-configuration-server certificate))
|
|
(key-type (lego-certificate-configuration-key-type certificate))
|
|
(state-dir (lego-certificate-directory certificate)))
|
|
(append
|
|
(list "--accept-tos"
|
|
"--path" state-dir)
|
|
(if email
|
|
(list "--email" email)
|
|
'())
|
|
(if (and listen-http webroot)
|
|
(error "lego certificate cannot use both listen-http and webroot"
|
|
(lego-certificate-configuration-name certificate))
|
|
'())
|
|
(cond
|
|
(listen-http
|
|
(list "--http" "--http.port" listen-http))
|
|
(webroot
|
|
(list "--http" "--http.webroot" webroot))
|
|
(else
|
|
(list "--http")))
|
|
(if server
|
|
(list "--server" server)
|
|
'())
|
|
(if (any ip-subject? subjects)
|
|
(list "--disable-cn")
|
|
'())
|
|
(list "--key-type" key-type)
|
|
(append-map (lambda (subject)
|
|
(list "-d" subject))
|
|
subjects))))
|
|
|
|
(define (lego-self-signed-activation-gexp certificate)
|
|
(let* ((state-dir (lego-certificate-directory certificate))
|
|
(primary-subject (car (lego-certificate-configuration-subjects certificate)))
|
|
(san-string (string-append
|
|
"subjectAltName="
|
|
(string-join
|
|
(map subject->san-entry
|
|
(lego-certificate-configuration-subjects certificate))
|
|
",")))
|
|
(initial-cert (string-append state-dir "/initial.pem"))
|
|
(fullchain (string-append state-dir "/fullchain.pem"))
|
|
(chain (string-append state-dir "/chain.pem"))
|
|
(cert-output (string-append state-dir "/cert.pem"))
|
|
(key-output (string-append state-dir "/key.pem"))
|
|
(full-pem (string-append state-dir "/full.pem")))
|
|
#~(begin
|
|
(use-modules (guix build utils)
|
|
(ice-9 textual-ports))
|
|
(mkdir-p #$state-dir)
|
|
(when #$(lego-certificate-configuration-webroot certificate)
|
|
(mkdir-p (string-append
|
|
#$(lego-certificate-configuration-webroot certificate)
|
|
"/.well-known/acme-challenge")))
|
|
(unless (file-exists? #$fullchain)
|
|
(invoke #$(file-append openssl "/bin/openssl")
|
|
"req"
|
|
"-x509"
|
|
"-newkey" "rsa:2048"
|
|
"-keyout" #$key-output
|
|
"-out" #$initial-cert
|
|
"-sha256"
|
|
"-days" "1"
|
|
"-nodes"
|
|
"-subj" #$(string-append "/CN=" primary-subject)
|
|
"-addext" #$san-string)
|
|
(copy-file #$initial-cert #$fullchain)
|
|
(copy-file #$initial-cert #$chain)
|
|
(copy-file #$initial-cert #$cert-output)
|
|
(call-with-output-file #$full-pem
|
|
(lambda (port)
|
|
(display (call-with-input-file #$key-output get-string-all) port)
|
|
(display (call-with-input-file #$fullchain get-string-all) port)))))))
|
|
|
|
(define (lego-certificate-program config certificate)
|
|
(let* ((state-dir (lego-certificate-directory certificate))
|
|
(certificate-dir (string-append state-dir "/certificates"))
|
|
(key-name (certificate-key-name certificate))
|
|
(certificate-file (string-append certificate-dir "/" key-name ".crt"))
|
|
(issuer-file (string-append certificate-dir "/" key-name ".issuer.crt"))
|
|
(private-key (string-append certificate-dir "/" key-name ".key"))
|
|
(fullchain (string-append state-dir "/fullchain.pem"))
|
|
(chain (string-append state-dir "/chain.pem"))
|
|
(cert-output (string-append state-dir "/cert.pem"))
|
|
(key-output (string-append state-dir "/key.pem"))
|
|
(full-pem (string-append state-dir "/full.pem"))
|
|
(run-arguments
|
|
(append (lego-common-arguments certificate)
|
|
(list "run")
|
|
(if (lego-certificate-configuration-profile certificate)
|
|
(list (string-append
|
|
"--profile="
|
|
(lego-certificate-configuration-profile certificate)))
|
|
'())))
|
|
(renew-arguments
|
|
(append (lego-common-arguments certificate)
|
|
(list "renew" "--no-random-sleep")
|
|
(if (lego-certificate-configuration-profile certificate)
|
|
(list (string-append
|
|
"--profile="
|
|
(lego-certificate-configuration-profile certificate)))
|
|
'())
|
|
(if (lego-certificate-configuration-renew-days certificate)
|
|
(list "--days"
|
|
(number->string
|
|
(lego-certificate-configuration-renew-days certificate)))
|
|
(list "--dynamic")))))
|
|
(program-file
|
|
(string-append "lego-" (lego-certificate-configuration-name certificate))
|
|
(with-imported-modules '((gnu services herd)
|
|
(guix build utils))
|
|
#~(begin
|
|
(use-modules (gnu services herd)
|
|
(guix build utils)
|
|
(ice-9 textual-ports))
|
|
|
|
(define (file-contents path)
|
|
(and (file-exists? path)
|
|
(call-with-input-file path get-string-all)))
|
|
|
|
(define (fullchain-changed?)
|
|
(let ((old (file-contents #$fullchain))
|
|
(new (file-contents #$certificate-file)))
|
|
(not (equal? old new))))
|
|
|
|
(mkdir-p #$state-dir)
|
|
|
|
(let ((lego #$(file-append
|
|
(lego-configuration-package config)
|
|
"/bin/lego"))
|
|
(run-args '#$run-arguments)
|
|
(renew-args '#$renew-arguments))
|
|
(if (file-exists? #$certificate-file)
|
|
(apply invoke lego renew-args)
|
|
(apply invoke lego run-args)))
|
|
|
|
(when (and (file-exists? #$certificate-file)
|
|
(fullchain-changed?))
|
|
(copy-file #$certificate-file #$fullchain)
|
|
(copy-file #$private-key #$key-output)
|
|
(if (file-exists? #$issuer-file)
|
|
(copy-file #$issuer-file #$chain)
|
|
(copy-file #$certificate-file #$chain))
|
|
(copy-file #$certificate-file #$cert-output)
|
|
(call-with-output-file #$full-pem
|
|
(lambda (port)
|
|
(display (call-with-input-file #$key-output get-string-all) port)
|
|
(display (call-with-input-file #$fullchain get-string-all) port)))
|
|
#$@(map (lambda (service)
|
|
#~(with-shepherd-action '#$service ('reload) result result))
|
|
(lego-certificate-configuration-reload-services certificate))))))))
|
|
|
|
(define (lego-certificate-service-symbol prefix certificate)
|
|
(string->symbol
|
|
(string-append prefix
|
|
"-"
|
|
(lego-certificate-configuration-name certificate))))
|
|
|
|
(define (lego-renewal-services config)
|
|
(append-map
|
|
(lambda (certificate)
|
|
(let ((program (lego-certificate-program config certificate)))
|
|
(list
|
|
(shepherd-service
|
|
(documentation
|
|
(string-append "Renew the ACME certificate for "
|
|
(lego-certificate-configuration-name certificate)
|
|
" on a timer."))
|
|
(provision
|
|
(list (lego-certificate-service-symbol "lego-renewal"
|
|
certificate)))
|
|
(requirement
|
|
(append '(user-processes networking)
|
|
(lego-certificate-configuration-requirement certificate)))
|
|
(modules '((shepherd service timer)))
|
|
(start
|
|
#~(let ((minutes '#$(lego-configuration-renew-minutes config))
|
|
(hours '#$(lego-configuration-renew-hours config)))
|
|
(make-timer-constructor
|
|
(calendar-event
|
|
#:minutes minutes
|
|
#:hours hours)
|
|
(command (list #$program))
|
|
#:wait-for-termination? #t)))
|
|
(stop #~(make-timer-destructor))
|
|
(actions
|
|
(list shepherd-trigger-action
|
|
(shepherd-configuration-action program))))
|
|
(shepherd-service
|
|
(documentation
|
|
(string-append "Attempt ACME renewal for "
|
|
(lego-certificate-configuration-name certificate)
|
|
" at boot."))
|
|
(provision
|
|
(list (lego-certificate-service-symbol "lego-bootstrap"
|
|
certificate)))
|
|
(requirement
|
|
(append '(user-processes networking)
|
|
(lego-certificate-configuration-requirement certificate)))
|
|
(one-shot? #t)
|
|
(start #~(lambda _
|
|
(zero? (system* #$program))))
|
|
(respawn? #f)))))
|
|
(lego-configuration-certificates config)))
|
|
|
|
(define (lego-activation config)
|
|
(let ((certificates (lego-configuration-certificates config)))
|
|
(with-imported-modules '((guix build utils))
|
|
#~(begin
|
|
(use-modules (guix build utils)
|
|
(ice-9 textual-ports))
|
|
(mkdir-p "/var/lib/lego")
|
|
#$@(map lego-self-signed-activation-gexp certificates)))))
|
|
|
|
(define lego-service-type
|
|
(service-type
|
|
(name 'lego)
|
|
(extensions
|
|
(list (service-extension activation-service-type
|
|
lego-activation)
|
|
(service-extension shepherd-root-service-type
|
|
lego-renewal-services)
|
|
(service-extension profile-service-type
|
|
(compose list lego-configuration-package))))
|
|
(default-value (lego-configuration))
|
|
(description "Issue and renew ACME certificates with Lego.")))
|