diff options
Diffstat (limited to 'guix')
| -rw-r--r-- | guix/forge/acme.scm | 432 |
1 files changed, 431 insertions, 1 deletions
diff --git a/guix/forge/acme.scm b/guix/forge/acme.scm index ee715ae..690f1e4 100644 --- a/guix/forge/acme.scm +++ b/guix/forge/acme.scm @@ -18,16 +18,57 @@ ;;; <https://www.gnu.org/licenses/>. (define-module (forge acme) + #:use-module ((gnu packages admin) #:select (shadow)) #:use-module ((gnu packages autotools) #:select (autoconf automake)) + #:use-module ((gnu packages certs) #:select (nss-certs)) #:use-module ((gnu packages curl) #:select (curl)) #:use-module ((gnu packages documentation) #:select (asciidoc)) #:use-module ((gnu packages pkg-config) #:select (pkg-config)) #:use-module ((gnu packages tls) #:select (gnutls)) + #:use-module (gnu services) + #:use-module (gnu services mcron) + #:use-module (gnu system shadow) #:use-module (guix build-system gnu) + #:use-module (guix diagnostics) #:use-module (guix gexp) #:use-module (guix git-download) + #:use-module (guix i18n) #:use-module ((guix licenses) #:prefix license:) - #:use-module (guix packages)) + #:use-module (guix packages) + #:use-module (guix profiles) + #:use-module (guix records) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:export (acme-service-type + <acme-configuration> + acme-configuration + acme-configuration? + acme-configuration-uacme + acme-configuration-email + acme-configuration-acme-url + acme-configuration-state-directory + acme-configuration-http-01-challenge-directory + acme-configuration-http-01-authorization-hook + acme-configuration-http-01-cleanup-hook + acme-configuration-key + acme-configuration-certificates + %letsencrypt-production-url + %letsencrypt-staging-url + acme-http-01-webroot-authorization-hook + acme-http-01-webroot-cleanup-hook + <acme-rsa-key> + acme-rsa-key + acme-rsa-key? + acme-rsa-key-length + <acme-ecdsa-key> + acme-ecdsa-key + acme-ecdsa-key? + acme-ecdsa-key-length + <acme-certificate> + acme-certificate + acme-certificate? + acme-certificate-domains + acme-certificate-deploy-hook)) (define-public uacme (package @@ -77,3 +118,392 @@ challenge environment to the user or hook. uacme also includes ualpn, a lightweight proxying tls-alpn-01 challenge responder compliant with RFC8737 and RFC8738.") (license license:gpl3+))) + +(define-record-type* <acme-rsa-key> + acme-rsa-key make-acme-rsa-key + acme-rsa-key? + (length acme-rsa-key-length + (default 2048) + (sanitize sanitize-acme-rsa-key-length))) + +(define (sanitize-acme-rsa-key-length length) + (if (and (zero? (remainder length 8)) + (>= length 2048) + (<= length 8192)) + length + (leave (G_ "RSA ACME key length ~a is invalid. It must be a multiple of 8 between 2048 and 8192.~%") + length))) + +(define-record-type* <acme-ecdsa-key> + acme-ecdsa-key make-acme-ecdsa-key + acme-ecdsa-key? + (length acme-ecdsa-key-length + (default 256) + (sanitize sanitize-acme-ecdsa-key-length))) + +(define (sanitize-acme-ecdsa-key-length length) + (if (memv length (list 256 384)) + length + (leave (G_ "ECDSA ACME key length ~a is invalid. It must either be 256 or 384.~%") + length))) + +(define (acme-key-length key) + (cond + ((acme-rsa-key? key) + (acme-rsa-key-length key)) + ((acme-ecdsa-key? key) + (acme-ecdsa-key-length key)))) + +(define %letsencrypt-production-url + "https://acme-v02.api.letsencrypt.org/directory") + +(define %letsencrypt-staging-url + "https://acme-staging-v02.api.letsencrypt.org/directory") + +(define-record-type* <acme-configuration> + acme-configuration make-acme-configuration + acme-configuration? + this-acme-configuration + (uacme acme-configuration-uacme + (default uacme)) + (email acme-configuration-email + (default #false)) + (acme-url acme-configuration-acme-url + (default %letsencrypt-production-url)) + (state-directory acme-configuration-state-directory + (default "/var/lib/acme")) + (http-01-challenge-directory acme-configuration-http-01-challenge-directory + (default "/var/run/acme/acme-challenge")) + (http-01-authorization-hook acme-configuration-http-01-authorization-hook + (default (program-file "acme-http-01-authorization-hook" + (acme-http-01-webroot-authorization-gexp this-acme-configuration))) + (thunked)) + (http-01-cleanup-hook acme-configuration-http-01-cleanup-hook + (default (program-file "acme-http-01-cleanup-hook" + (acme-http-01-webroot-cleanup-gexp this-acme-configuration))) + (thunked)) + (key acme-configuration-key + (default (acme-ecdsa-key)) + (sanitize sanitize-acme-key)) + (certificates acme-configuration-certificates + (default '()))) + +(define (sanitize-acme-key key) + (if (or (acme-rsa-key? key) + (acme-ecdsa-key? key)) + key + (leave (G_ "Unsupported ACME key ~s~%") + key))) + +(define-record-type* <acme-certificate> + acme-certificate make-acme-certificate? + acme-certificate? + (domains acme-certificate-domains) + (deploy-hook acme-certificate-deploy-hook + (default #false))) + +(define (acme-http-01-webroot-authorization-gexp config) + "Return a HTTP-01 authorization G-expression for the ACME service +described by @var{config}. The G-expression installs a challenge file +in the configured challenge directory." + (match-record config <acme-configuration> + (http-01-challenge-directory) + #~(begin + (use-modules (srfi srfi-26) + (ice-9 match)) + + (match (command-line) + ((_ identifier token auth) + (let ((challenge-file (string-append #$http-01-challenge-directory "/" token))) + (call-with-output-file challenge-file + (cut display auth <>)))))))) + +(define (acme-http-01-webroot-cleanup-gexp config) + "Return a HTTP-01 cleanup G-expression for the ACME service described +by @var{config}. The G-expression cleans up the challenge file +installed by the authorization hook in the configured challenge +directory." + (match-record config <acme-configuration> + (http-01-challenge-directory) + #~(begin + (use-modules (ice-9 match)) + + (match (command-line) + ((_ identifier token auth) + (delete-file (string-append #$http-01-challenge-directory "/" token))))))) + +(define (uacme-hook-gexp config) + "Put together authorization and cleanup hooks described in +@var{config} into a hook suitable for passing to uacme." + (match-record config <acme-configuration> + (http-01-authorization-hook http-01-cleanup-hook) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 match)) + + (match (command-line) + ((_ "begin" "http-01" identifier token auth) + (invoke #$http-01-authorization-hook + identifier token auth)) + ((_ (or "done" "failed") "http-01" identifier token auth) + (invoke #$http-01-cleanup-hook + identifier token auth)) + ;; Decline other types of challenges. + (_ (exit #false))))))) + +(define %acme-accounts + (list (user-account + (name "acme") + (group "acme") + (system? #true) + (comment "ACME user") + (home-directory "/var/empty") + (shell (file-append shadow "/sbin/nologin"))) + (user-group + (name "acme") + (system? #true)))) + +(define acme-activation + (match-record-lambda <acme-configuration> + (state-directory http-01-challenge-directory key certificates) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils) + (ice-9 match) + (srfi srfi-26)) + + ;; Create state directory. + (mkdir-p #$state-directory) + + ;; Create keys and self-signed certificates if none exist so + ;; that services (such as nginx) that need the certificates + ;; don't fail to start. + (for-each (match-lambda + ((identifier certificate-template-file) + (let* ((key-file (string-append #$state-directory "/private/" identifier "/key.pem")) + (certificate-file (string-append #$state-directory "/" identifier "/cert.pem"))) + (unless (and (file-exists? key-file) + (file-exists? certificate-file)) + (mkdir-p (dirname key-file)) + (invoke #$(file-append gnutls "/bin/certtool") + "--generate-privkey" + "--key-type" #$(cond + ((acme-rsa-key? key) "rsa") + ((acme-ecdsa-key? key) "ecdsa")) + "--bits" #$(number->string (acme-key-length key)) + "--outfile" key-file) + (chmod key-file #o400) + (mkdir-p (dirname certificate-file)) + (invoke #$(file-append gnutls "/bin/certtool") + "--generate-self-signed" + "--template" certificate-template-file + "--load-privkey" key-file + "--outfile" certificate-file))))) + '#$(map (match-record-lambda <acme-certificate> + (domains) + (let ((identifier (first domains))) + (list identifier + (plain-file "certtool-template.cfg" + (format #f + "cn = \"~a\" +expiration_days = 1 +~{dns_name = \"~a\"~%~} +signing_key +encryption_key +tls_www_server +" + identifier + domains))))) + certificates)) + + ;; Set ownership of state directory and its contents. + (let ((user (getpw "acme"))) + (for-each (cut chown <> (passwd:uid user) (passwd:gid user)) + (find-files #$state-directory #:directories? #t)) + + ;; Create challenge directory and make it world readable, + ;; but only writable by the acme user. + (mkdir-p #$http-01-challenge-directory) + (chown #$http-01-challenge-directory (passwd:uid user) (passwd:gid user)) + (chmod #$http-01-challenge-directory #o755)) + + ;; Advise user about setup unless account key already + ;; exists. + (unless (file-exists? #$(string-append state-directory "/private/key.pem")) + (display " +If this is the first time you are using the acme service, please +register by running `/usr/bin/acme register' and initialize your +certificates by running `/usr/bin/acme renew' + +")))))) + +(define* (acme-renew config #:key quiet?) + "Return a G-expression that renews certificates described in +@var{config}. Unless @var{quiet?} is #true, be verbose." + (match-record config <acme-configuration> + (uacme email acme-url state-directory key certificates) + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + ;; Set path to TLS certificates for verification of HTTPS + ;; servers. + (setenv "SSL_CERT_FILE" + #$(file-append (profile + (content (packages->manifest (list curl nss-certs)))) + "/etc/ssl/certs/ca-certificates.crt")) + + ;; Register ACME account if account does not already exist. We + ;; assume the presence of an account key implies the existence + ;; of an account. + (unless (file-exists? #$(string-append state-directory "/private/key.pem")) + (system* #$(file-append uacme "/bin/uacme") + "--verbose" + "--confdir" #$state-directory + "--acme-url" #$acme-url + "--yes" + "new" + #$@(if email + (list email) + (list)))) + + ;; Renew configured certificates. + (for-each (match-lambda + ((domains deploy-hook) + ;; uacme returns 0 on successful renewal, 1 when + ;; there is no need to renew, and 2 on other + ;; failures. + (case (status:exit-val + (apply system* + #$(file-append uacme "/bin/uacme") + "--confdir" #$state-directory + "--acme-url" #$acme-url + "--type" #$(cond + ((acme-rsa-key? key) "RSA") + ((acme-ecdsa-key? key) "EC")) + "--bits" #$(number->string (acme-key-length key)) + "--hook" #$(program-file "uacme-hook" + (uacme-hook-gexp config)) + "issue" + #$@(if quiet? + (list) + (list "--verbose")) + domains)) + ((0) (invoke deploy-hook)) + ((2) (exit #false))))) + '#$(map (match-record-lambda <acme-certificate> + (domains deploy-hook) + (list domains + deploy-hook)) + certificates)))))) + +(define (acme-helper config) + "Return a G-expression for a interactive ACME helper tool. Bake in +parameters described in @var{config}." + (match-record config <acme-configuration> + (uacme state-directory acme-url email) + #~(begin + (use-modules (ice-9 match)) + + (match (command-line) + ((command "renew") + #$(acme-renew config)) + ((command _ ...) + (format (current-error-port) + "Usage: ~a COMMAND + +Valid COMMANDs are + +renew: Issue or renew configured certificates + +" + command) + (exit #false)))))) + +(define (acme-helper-sudo-wrapper config) + #~(begin + (use-modules (ice-9 match)) + + (match (command-line) + ((_ arguments ...) + (apply system* + ;; We cannot refer to sudo in the store since that sudo + ;; does not have the setuid bit set. See "(guix) Setuid + ;; Programs". + "/run/setuid-programs/sudo" + "--user" "acme" + "--group" "acme" + #$(program-file "acme-helper" (acme-helper config)) + arguments))))) + +(define (acme-special-files config) + `(("/usr/bin/acme" ,(program-file "acme" + (acme-helper-sudo-wrapper config))))) + +(define (acme-cron-job config) + ;; Attempt to renew certificates once a day, at a random minute + ;; within the day. This helps even out the load on the ACME + ;; server. + #~(job '(next-minute-from (next-hour '(0)) + (list (random (* 24 60)))) + #$(program-file "acme-renew-cron" + (acme-renew config #:quiet? #true)) + #:user "acme")) + +(define (raise-to-top pred lst) + "Reorder @var{lst} so that the first element that satisfies @var{pred} +is the first element. The order of the remaining elements is +unspecified. If no element matching @var{pred} is found, return +@code{#f}." + (and (find pred lst) + (append (find-tail pred lst) + (take-while (negate pred) lst)))) + +(define acme-service-type + (service-type + (name 'acme) + (description "Automatically fetch and renew ACME certificates.") + (extensions (list (service-extension account-service-type + (const %acme-accounts)) + (service-extension activation-service-type + acme-activation) + (service-extension special-files-service-type + acme-special-files) + (service-extension mcron-service-type + (compose list acme-cron-job)))) + (compose concatenate) + (extend (lambda (config certificates) + (acme-configuration + (inherit config) + (certificates + ;; Append new certificates onto existing ones. When any + ;; of the new certificates are for the same domains as + ;; existing certificates, combine them into a single + ;; certificate. + (fold (lambda (certificate previous-certificates) + (cond + ((raise-to-top (lambda (this-certificate) + (lset= string=? + (acme-certificate-domains this-certificate) + (acme-certificate-domains certificate))) + previous-certificates) + => (match-lambda + ((matched-certificate other-certificates ...) + (cons (acme-certificate + (inherit certificate) + ;; Combine deploy hooks of the + ;; two certificates. + (deploy-hook + (with-imported-modules '((guix build utils)) + #~(begin + (use-modules (guix build utils)) + + (invoke #$(acme-certificate-deploy-hook certificate)) + (invoke #$(acme-certificate-deploy-hook matched-certificate)))))) + other-certificates)))) + (else + (cons certificate previous-certificates)))) + (acme-configuration-certificates config) + certificates))))) + (default-value (acme-configuration)))) |