From 2508079864766afc3b6d3b670547b827c7a84ef7 Mon Sep 17 00:00:00 2001 From: Vivien Kraus Date: Sun, 26 Sep 2021 00:02:44 +0200 Subject: Update package --- vkraus/services/disfluid.scm | 766 +++++++++++++++++++++++-------------------- 1 file changed, 412 insertions(+), 354 deletions(-) (limited to 'vkraus/services') diff --git a/vkraus/services/disfluid.scm b/vkraus/services/disfluid.scm index ecd0f33..21adca2 100644 --- a/vkraus/services/disfluid.scm +++ b/vkraus/services/disfluid.scm @@ -23,354 +23,387 @@ #:use-module (gnu packages admin) #:use-module (vkraus packages disfluid) #:use-module (guix gexp) - #:use-module (guix packages) #:use-module (guix modules) + #:use-module (guix records) #:use-module (ice-9 match) - #:use-module (ice-9 optargs) - #:use-module (ice-9 receive) - #:use-module (web uri) - #:use-module (oop goops) - #:declarative? #t - #:export - ( - - disfluid-package - extra-options - - complete-corresponding-source - port - - issuer - key-file - subject - encrypted-password-file - jwks-uri - authorization-endpoint-uri - token-endpoint-uri - - inbound-uri - outbound-uri - header - - - client-id - redirect-uri - client-name - client-uri - - server-name - - kind - document - invocation - ->shepherd-service - ->log-rotation - - disfluid-service-type - disfluid-website - )) - -(define-class () - (disfluid-package - #:init-keyword #:disfluid-package - #:init-value disfluid - #:getter disfluid-package) + #:use-module (ice-9 optargs)) + +(define-record-type* + disfluid-issuer-configuration + make-disfluid-issuer-configuration + disfluid-issuer-configuration? + (disfluid disfluid-issuer-configuration-disfluid + (default disfluid)) + (complete-corresponding-source + disfluid-issuer-configuration-complete-corresponding-source) + (issuer disfluid-issuer-configuration-issuer) + (key-file disfluid-issuer-configuration-key-file) + (subject disfluid-issuer-configuration-subject) + (encrypted-password-file disfluid-issuer-configuration-encrypted-password-file) + (jwks-uri disfluid-issuer-configuration-jwks-uri) + (authorization-endpoint-uri + disfluid-issuer-configuration-authorization-endpoint-uri) + (token-endpoint-uri + disfluid-issuer-configuration-token-endpoint-uri) + (port disfluid-issuer-configuration-port (default 8088)) (extra-options - #:init-keyword #:extra-options - #:init-value '() - #:getter extra-options)) - -(define-class () + disfluid-issuer-configuration-extra-options + (default '()))) + +(define-record-type* + disfluid-reverse-proxy-configuration + make-disfluid-reverse-proxy-configuration + disfluid-reverse-proxy-configuration? + (disfluid disfluid-reverse-proxy-configuration-disfluid + (default disfluid)) (complete-corresponding-source - #:init-keyword #:complete-corresponding-source - #:getter complete-corresponding-source) - (port - #:init-keyword #:port - #:getter port)) - -(define-class () - (issuer #:init-keyword #:issuer #:getter issuer) - (key-file #:init-keyword #:key-file #:getter key-file) - (subject #:init-keyword #:subject #:getter subject) - (encrypted-password-file - #:init-keyword #:encrypted-password-file - #:accessor encrypted-password-file) - (jwks-uri #:init-keyword #:jwks-uri #:getter jwks-uri) + disfluid-reverse-proxy-configuration-complete-corresponding-source) + (port disfluid-reverse-proxy-port (default 8090)) + (inbound-uri disfluid-reverse-proxy-configuration-inbound-uri) + (outbound-uri disfluid-reverse-proxy-configuration-outbound-uri) + (header disfluid-reverse-proxy-configuration-header + (default "XXX-Agent")) + (extra-options + disfluid-reverse-proxy-extra-options + (default '()))) + +(define-record-type* + disfluid-hello-configuration + make-disfluid-hello-configuration + disfluid-hello-configuration? + (disfluid disfluid-hello-configuration-disfluid + (default disfluid)) + (complete-corresponding-source + disfluid-hello-configuration-complete-corresponding-source) + (port disfluid-hello-configuration-port (default 8089)) + (extra-options + disfluid-hello-configuration-extra-options + (default '()))) + +(define-record-type* + disfluid-client-service-configuration + make-disfluid-client-service-configuration + disfluid-client-service-configuration? + (disfluid disfluid-client-service-configuration-disfluid + (default disfluid)) + (complete-corresponding-source + disfluid-client-service-configuration-complete-corresponding-source) + (client-id disfluid-client-service-configuration-client-id) + (redirect-uri disfluid-client-service-configuration-redirect-uri) + (client-name disfluid-client-service-configuration-client-name (default "Example Solid App")) + (client-uri disfluid-client-service-configuration-client-uri (default "https://webid-oidc.planete-kraus.eu/Running-a-client.html#Running-a-client")) + (port disfluid-client-service-configuration-port (default 8088)) + (extra-options + disfluid-client-service-configuration-extra-options + (default '()))) + +(define-record-type* + disfluid-server-configuration + make-disfluid-server-configuration + disfluid-server-configuration? + (disfluid disfluid-server-configuration-disfluid + (default disfluid)) + (complete-corresponding-source + disfluid-server-configuration-complete-corresponding-source) + (server-name disfluid-server-configuration-server-name) + (key-file disfluid-server-configuration-key-file) + (subject disfluid-server-configuration-subject) + (encrypted-password-file disfluid-server-configuration-encrypted-password-file) + (jwks-uri disfluid-server-configuration-jwks-uri) (authorization-endpoint-uri - #:init-keyword #:authorization-endpoint-uri - #:getter authorization-endpoint-uri) + disfluid-server-configuration-authorization-endpoint-uri) (token-endpoint-uri - #:init-keyword #:token-endpoint-uri - #:getter token-endpoint-uri)) - -(define-class () - (inbound-uri #:init-keyword #:inbound-uri #:getter inbound-uri) - (outbound-uri #:init-keyword #:outbound-uri #:getter outbound-uri) - (header #:init-keyword #:header #:getter header #:init-value "XXX-Agent")) - -(define-class ()) - -(define-class () - (client-id #:init-keyword #:client-id #:getter client-id) - (redirect-uri #:init-keyword #:redirect-uri #:getter redirect-uri) - (client-name - #:init-keyword #:client-name - #:getter client-name - #:init-value "Example Solid App") - (client-uri - #:init-keyword #:client-uri - #:getter client-uri - #:init-value (string->uri - "https://disfluid.planete-kraus.eu/Running-a-client.html#Running-a-client"))) - -(define-class () - (server-name #:init-keyword #:server-name #:getter server-name)) - -(define-method (initialize (cfg ) initargs) - (next-method) - (unless (package? (disfluid-package cfg)) - (scm-error 'wrong-type-arg "make " - "#:disfluid-package argument should be a package" - '() - (list (disfluid-package cfg)))) - (unless (list? (extra-options cfg)) - (scm-error 'wrong-type-arg "make " - "#:extra-options argument should be a list" - '() - (list (extra-options cfg))))) - -(define-method (initialize (cfg ) initargs) - (next-method) - (let ((ccs (complete-corresponding-source cfg)) - (port (port cfg))) - (unless (or (string? ccs) (uri? ccs)) - (scm-error 'wrong-type-arg "make " - "#:complete-corresponding-source should be a string or an URI" - '() - (list ccs))) - (unless (and (integer? port) - (> port 0) - (< port 65536)) - (scm-error 'wrong-type-arg "make " - "#:port should be a port number" - '() - (list port))))) - -(define string->uri* - ;; Try to convert a string to an URI, but keep the old value if it - ;; fails - (match-lambda - ((or (? uri? uri) - (? string? (= string->uri (? uri? uri)))) - uri) - (non-uri non-uri))) - -(define (uri-slot! object slot-name) - (slot-set! object slot-name - (string->uri* (slot-ref object slot-name))) - (unless (uri? (slot-ref object slot-name)) - (scm-error 'wrong-type-arg "make" - (format #f "#:~a should be an URI" slot-name) - '() - (list (slot-ref object slot-name))))) - -(define (string/file-like-slot! object slot-name) - (let ((value (slot-ref object slot-name))) - (unless (or (string? value) (file-like? value)) - (scm-error 'wrong-type-arg "make" - (format #f "#:~a should be a file name or a file-like object" - slot-name) - '() - (list value))))) - -(define-method (initialize (cfg ) initargs) - (next-method) - (uri-slot! cfg 'issuer) - (string/file-like-slot! cfg 'key-file) - (uri-slot! cfg 'subject) - (string/file-like-slot! cfg 'encrypted-password-file) - (uri-slot! cfg 'jwks-uri) - (uri-slot! cfg 'authorization-endpoint-uri) - (uri-slot! cfg 'token-endpoint-uri)) - -(define-method (initialize (cfg ) initargs) - (next-method) - (uri-slot! cfg 'inbound-uri) - (uri-slot! cfg 'outbound-uri) - (when (symbol? (header cfg)) - (slot-set! cfg 'header (symbol->string (header cfg)))) - (unless (string? (header cfg)) - (scm-error 'wrong-type-arg "make" - "#:header should be a symbol or a string") - '() - (list (header cfg)))) - -(define-method (initialize (cfg ) initargs) - (next-method) - (uri-slot! cfg 'client-id) - (uri-slot! cfg 'redirect-uri) - (unless (string? (client-name cfg)) - (scm-error 'wrong-type-arg "make" - "#:client-name should be a string") - '() - (list (client-name cfg))) - (uri-slot! cfg 'client-uri)) - -(define-method (initialize (cfg ) initargs) - (let-keywords - initargs #t - ((server-name #f)) - (begin - (slot-set! cfg 'server-name server-name) - (uri-slot! cfg 'server-name) - (slot-set! cfg 'issuer server-name) - (uri-slot! cfg 'issuer))) - ;; #:issuer defaults to the server name - (next-method) - ;; server-name has been reset - (uri-slot! cfg 'server-name)) - -(define-method (kind (cfg )) - "issuer") - -(define-method (kind (cfg )) - "reverse-proxy") - -(define-method (kind (cfg )) - "hello") - -(define-method (kind (cfg )) - "client-service") - -(define-method (kind (cfg )) - "server") - -(define-method (document (cfg ) (id )) - (format #f "Run a Solid identity provider for ~a (~a)" - (uri->string (issuer cfg)) id)) - -(define-method (document (cfg ) (id )) - (format #f "Run a Solid reverse proxy from ~a to ~a (~a)" - (uri->string (inbound-uri cfg)) (outbound-uri cfg) id)) - -(define-method (document (cfg ) (id )) - (format #f "Run a demonstration Solid server on port ~a (~a)" - (port cfg) id)) - -(define-method (document (cfg ) (id )) - (format #f "Serve the public pages for ~a (~a)" - (uri->string (client-id cfg)) id)) - -(define-method (document (cfg ) (id )) - (format #f "Run the Solid server ~a (~a)" - (uri->string (server-name cfg)) id)) - -(define-method (invocation (cfg ) (id )) - ;; Return the program name, command and arguments - (values "/bin/disfluid" - #f - `("-l" ,(string-append (kind cfg) "-" id ".log") - "-e" ,(string-append (kind cfg) "-" id ".err") - ,@(extra-options cfg)))) - -(define-method (invocation (cfg ) (id )) - (receive (program-name command arguments) (next-method) - (values program-name - command - `("-S" ,(let ((ccs (complete-corresponding-source cfg))) - (if (uri? ccs) (uri->string ccs) ccs)) - "-p" ,(with-output-to-string - (lambda () (display (port cfg)))) - ,@arguments)))) - -(define-method (invocation (cfg ) (id )) - (receive (_program _command arguments) (next-method) - (values "/bin/disfluid" - "identity-provider" - `("-n" (uri->string (issuer cfg)) - "-k" (key-file cfg) - "-s" (uri->string (subject cfg)) - "-W" (encrypted-password-file cfg) - "-j" (uri->string (jwks-uri cfg)) - "-a" (uri->string (authorization-endpoint-uri cfg)) - "-t" (uri->string (token-endpoint-uri cfg)) - ,@arguments)))) - -(define-method (invocation (cfg ) (id )) - (receive (_program _command arguments) (next-method) - (values "/bin/disfluid" - "reverse-proxy" - `("-n" (uri->string (inbound-uri cfg)) - "-b" (uri->string (outbound-uri cfg)) - "-H" (header cfg) - ,@arguments)))) - -(define-method (invocation (cfg ) (id )) - (receive (_program _command arguments) (next-method) - (values "/bin/disfluid-hello" - #f - arguments))) - -(define-method (invocation (cfg ) (id )) - (receive (_program _command arguments) (next-method) - (values "/bin/disfluid" - "client-service" - `("-c" (uri->string (client-id cfg)) - "-r" (uri->string (redirect-uri cfg)) - "-C" (client-name cfg) - "-u" (uri->string (client-uri cfg)) - ,@arguments)))) - -(define-method (invocation (cfg ) (id )) - (receive (_program _command arguments) (next-method) - (values "/bin/disfluid" - "server" - `("-n" (uri->string (server-name cfg)) - ,@arguments)))) - -(define (->shepherd-service cfg id) - (receive (program-name command arguments) (invocation cfg id) - (define all-arguments `(command ,@arguments)) - (shepherd-service - (provision (list (string->symbol (format #f "disfluid-~a" id)))) - (documentation (document cfg id)) - (requirement '(user-processes)) - (modules '((gnu build shepherd) - (gnu system file-systems))) - (start - (with-imported-modules - '((gnu build shepherd) - (gnu system file-systems)) - #~(begin - (let* ((user (getpwnam "disfluid")) - (prepare-directory - (lambda (dir) - (mkdir-p dir) - (chown dir (passwd:uid user) (passwd:gid user)) - (chmod dir #o700)))) - (prepare-directory "/var/log/disfluid") - (prepare-directory #$(format #f "/var/lib/disfluid/~a" id)) - (prepare-directory #$(format #f "/var/cache/disfluid/~a" id))) - (make-forkexec-constructor - (cons (string-append #$(disfluid-package cfg) #$program-name) - #$all-arguments) - #:user "disfluid" - #:group "disfluid" - #:directory "/var/log/disfluid" - #:environment-variables - '(#$(format #f "XDG_DATA_HOME=/var/lib/disfluid/~a" id) - #$(format #f "XDG_CACHE_HOME=/var/cache/disfluid/~a" id)))))) - (stop #~(make-kill-destructor))))) + disfluid-server-configuration-token-endpoint-uri) + (port disfluid-server-configuration-port (default 8088)) + (extra-options + disfluid-issuer-configuration-extra-options + (default '()))) + +(export + disfluid-issuer-configuration + make-disfluid-issuer-configuration + disfluid-issuer-configuration? + disfluid-issuer-configuration-disfluid + disfluid-issuer-configuration-complete-corresponding-source + disfluid-issuer-configuration-issuer + disfluid-issuer-configuration-key-file + disfluid-issuer-configuration-subject + disfluid-issuer-configuration-encrypted-password-file + disfluid-issuer-configuration-jwks-uri + disfluid-issuer-configuration-authorization-endpoint-uri + disfluid-issuer-configuration-token-endpoint-uri + disfluid-issuer-configuration-port + disfluid-issuer-configuration-extra-options + + disfluid-reverse-proxy-configuration + make-disfluid-reverse-proxy-configuration + disfluid-reverse-proxy-configuration? + disfluid-reverse-proxy-configuration-disfluid + disfluid-reverse-proxy-configuration-complete-corresponding-source + disfluid-reverse-proxy-configuration-port + disfluid-reverse-proxy-configuration-inbound-uri + disfluid-reverse-proxy-configuration-outbound-uri + disfluid-reverse-proxy-configuration-header + disfluid-reverse-proxy-configuration-extra-options + + disfluid-hello-configuration + make-disfluid-hello-configuration + disfluid-hello-configuration? + disfluid-hello-configuration-disfluid + disfluid-hello-configuration-complete-corresponding-source + disfluid-hello-configuration-port + disfluid-hello-configuration-extra-options + + disfluid-client-service-configuration + make-disfluid-client-service-configuration + disfluid-client-service-configuration? + disfluid-client-service-configuration-disfluid + disfluid-client-service-configuration-complete-corresponding-source + disfluid-client-service-configuration-client-id + disfluid-client-service-configuration-redirect-uri + disfluid-client-service-configuration-client-name + disfluid-client-service-configuration-client-uri + disfluid-client-service-configuration-port + disfluid-client-service-configuration-extra-options + + disfluid-server-configuration + make-disfluid-server-configuration + disfluid-server-configuration? + disfluid-server-configuration-disfluid + disfluid-server-configuration-complete-corresponding-source + disfluid-server-configuration-server-name + disfluid-server-configuration-key-file + disfluid-server-configuration-subject + disfluid-server-configuration-encrypted-password-file + disfluid-server-configuration-jwks-uri + disfluid-server-configuration-authorization-endpoint-uri + disfluid-server-configuration-token-endpoint-uri + disfluid-server-configuration-port + disfluid-server-configuration-extra-options) (define configuration->shepherd-service (match-lambda - (((or (? symbol? (= symbol->string id)) - (? string? id)) . cfg) - (list (->shepherd-service cfg id))) + ((id . ($ + disfluid ccs issuer key-file subject encrypted-password-file jwks-uri + authorization-endpoint-uri token-endpoint-uri port extra-options)) + `(,(shepherd-service + (provision (list (string->symbol (format #f "disfluid-~a" id)))) + (documentation (format #f "Run a Solid identity provider (~a)" id)) + (requirement '(user-processes)) + (modules '((gnu build shepherd) + (gnu system file-systems))) + (start + (with-imported-modules + (source-module-closure + '((gnu build shepherd) + (gnu system file-systems))) + #~(begin + (let* ((user (getpwnam "disfluid")) + (prepare-directory + (lambda (dir) + (mkdir-p dir) + (chown dir (passwd:uid user) (passwd:gid user)) + (chmod dir #o700)))) + (prepare-directory "/var/log/disfluid") + (prepare-directory #$(format #f "/var/lib/disfluid/~a" id)) + (prepare-directory #$(format #f "/var/cache/disfluid/~a" id))) + (make-forkexec-constructor + (list + (string-append #$disfluid "/bin/disfluid") + "identity-provider" + "-S" #$ccs + "-n" #$issuer + "-k" #$key-file + "-s" #$subject + "-W" #$encrypted-password-file + "-j" #$jwks-uri + "-a" #$authorization-endpoint-uri + "-t" #$token-endpoint-uri + "-p" (with-output-to-string (lambda () (display #$port))) + "-l" #$(format #f "issuer-~a.log" id) + "-e" #$(format #f "issuer-~a.err" id) + #$@extra-options) + #:user "disfluid" + #:group "disfluid" + #:directory "/var/log/disfluid" + #:environment-variables + '(#$(format #f "XDG_DATA_HOME=/var/lib/disfluid/~a" id) + #$(format #f "XDG_CACHE_HOME=/var/cache/disfluid/~a" id)))))) + (stop #~(make-kill-destructor))))) + ((id . ($ + disfluid ccs port inbound-uri outbound-uri header extra-options)) + `(,(shepherd-service + (provision (list (string->symbol (format #f "disfluid-~a" id)))) + (documentation (format #f "Run a Solid reverse proxy (~a)" id)) + (requirement '(user-processes)) + (modules '((gnu build shepherd) + (gnu system file-systems))) + (start + (with-imported-modules + (source-module-closure + '((gnu build shepherd) + (gnu system file-systems))) + #~(begin + (let* ((user (getpwnam "disfluid")) + (prepare-directory + (lambda (dir) + (mkdir-p dir) + (chown dir (passwd:uid user) (passwd:gid user)) + (chmod dir #o700)))) + (prepare-directory "/var/log/disfluid") + (prepare-directory #$(format #f "/var/lib/disfluid/~a" id)) + (prepare-directory #$(format #f "/var/cache/disfluid/~a" id))) + (make-forkexec-constructor + (list + (string-append #$disfluid "/bin/disfluid") + "reverse-proxy" + "-S" #$ccs + "-p" (with-output-to-string (lambda () (display #$port))) + "-n" #$inbound-uri + "-b" #$outbound-uri + "-H" #$header + "-l" #$(format #f "reverse-proxy-~a.log" id) + "-e" #$(format #f "reverse-proxy-~a.err" id) + #$@extra-options) + #:user "disfluid" + #:group "disfluid" + #:directory "/var/log/disfluid" + #:environment-variables + '(#$(format #f "XDG_DATA_HOME=/var/lib/disfluid/~a" id) + #$(format #f "XDG_CACHE_HOME=/var/cache/disfluid/~a" id)))))) + (stop #~(make-kill-destructor))))) + ((id . ($ + disfluid ccs port extra-options)) + `(,(shepherd-service + (provision (list (string->symbol (format #f "disfluid-~a" id)))) + (documentation (format #f "Run a demonstration Solid server (~a)" id)) + (requirement '(user-processes)) + (modules '((gnu build shepherd) + (gnu system file-systems))) + (start + (with-imported-modules + (source-module-closure + '((gnu build shepherd) + (gnu system file-systems))) + #~(begin + (let* ((user (getpwnam "disfluid")) + (prepare-directory + (lambda (dir) + (mkdir-p dir) + (chown dir (passwd:uid user) (passwd:gid user)) + (chmod dir #o700)))) + (prepare-directory "/var/log/disfluid") + (prepare-directory #$(format #f "/var/lib/disfluid/~a" id)) + (prepare-directory #$(format #f "/var/cache/disfluid/~a" id))) + (make-forkexec-constructor + (list + (string-append #$disfluid "/bin/disfluid-hello") + "-S" #$ccs + "-p" (with-output-to-string (lambda () (display #$port))) + "-l" #$(format #f "hello-~a.log" id) + "-e" #$(format #f "hello-~a.err" id) + #$@extra-options) + #:user "disfluid" + #:group "disfluid" + #:directory "/var/log/disfluid" + #:environment-variables + '(#$(format #f "XDG_DATA_HOME=/var/lib/disfluid/~a" id) + #$(format #f "XDG_CACHE_HOME=/var/cache/disfluid/~a" id)))))) + (stop #~(make-kill-destructor))))) + ((id . ($ + disfluid ccs client-id redirect-uri client-name client-uri port + extra-options)) + `(,(shepherd-service + (provision (list (string->symbol (format #f "disfluid-~a" id)))) + (documentation (format #f "Serve the public page for an application (~a)" id)) + (requirement '(user-processes)) + (modules '((gnu build shepherd) + (gnu system file-systems))) + (start + (with-imported-modules + (source-module-closure + '((gnu build shepherd) + (gnu system file-systems))) + #~(begin + (let* ((user (getpwnam "disfluid")) + (prepare-directory + (lambda (dir) + (mkdir-p dir) + (chown dir (passwd:uid user) (passwd:gid user)) + (chmod dir #o700)))) + (prepare-directory "/var/log/disfluid") + (prepare-directory #$(format #f "/var/lib/disfluid/~a" id)) + (prepare-directory #$(format #f "/var/cache/disfluid/~a" id))) + (make-forkexec-constructor + (list + (string-append #$disfluid "/bin/disfluid") + "client-service" + "-S" #$ccs + "-c" #$client-id + "-r" #$redirect-uri + "-C" #$client-name + "-u" #$client-uri + "-p" (with-output-to-string (lambda () (display #$port))) + "-l" #$(format #f "client-service-~a.log" id) + "-e" #$(format #f "client-service-~a.err" id) + #$@extra-options) + #:user "disfluid" + #:group "disfluid" + #:directory "/var/log/disfluid" + #:environment-variables + '(#$(format #f "XDG_DATA_HOME=/var/lib/disfluid/~a" id) + #$(format #f "XDG_CACHE_HOME=/var/cache/disfluid/~a" id)))))) + (stop #~(make-kill-destructor))))) + ((id . ($ + disfluid ccs server-name key-file subject encrypted-password-file jwks-uri + authorization-endpoint-uri token-endpoint-uri port + extra-options)) + `(,(shepherd-service + (provision (list (string->symbol (format #f "disfluid-~a" id)))) + (documentation (format #f "Run a full server (~a)" id)) + (requirement '(user-processes)) + (modules '((gnu build shepherd) + (gnu system file-systems))) + (start + (with-imported-modules + (source-module-closure + '((gnu build shepherd) + (gnu system file-systems))) + #~(begin + (let* ((user (getpwnam "disfluid")) + (prepare-directory + (lambda (dir) + (mkdir-p dir) + (chown dir (passwd:uid user) (passwd:gid user)) + (chmod dir #o700)))) + (prepare-directory "/var/log/disfluid") + (prepare-directory #$(format #f "/var/lib/disfluid/~a" id)) + (prepare-directory #$(format #f "/var/cache/disfluid/~a" id))) + (make-forkexec-constructor + (list + (string-append #$disfluid "/bin/disfluid") + "server" + "-S" #$ccs + "-n" #$server-name + "-k" #$key-file + "-s" #$subject + "-W" #$encrypted-password-file + "-j" #$jwks-uri + "-a" #$authorization-endpoint-uri + "-t" #$token-endpoint-uri + "-p" (with-output-to-string (lambda () (display #$port))) + "-l" #$(format #f "server-~a.log" id) + "-e" #$(format #f "server-~a.err" id) + #$@extra-options) + #:user "disfluid" + #:group "disfluid" + #:directory "/var/log/disfluid" + #:environment-variables + '(#$(format #f "XDG_DATA_HOME=/var/lib/disfluid/~a" id) + #$(format #f "XDG_CACHE_HOME=/var/cache/disfluid/~a" id)))))) + (stop #~(make-kill-destructor))))) ((items ...) - (apply append (map configuration->shepherd-service items))) - (only-one-cfg - (configuration->shepherd-service `(default . ,only-one-cfg))))) + (apply append (map configuration->shepherd-service items))))) (define %disfluid-accounts (list (user-group (name "disfluid") @@ -383,25 +416,50 @@ (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))) -(define-method (->log-rotation (cfg ) - (id )) - (log-rotation - (frequency 'daily) - (files - (map (lambda (ext) - (format #f "/var/log/disfluid/~a-~a.~a" (kind cfg) id ext)) - '("log err"))) - (options '("sharedscripts" "storedir /var/log/disfluid")))) - (define configuration->log-rotation (match-lambda - (((or (? symbol? (= symbol->string id)) - (? string? id)) . cfg) - (list (->log-rotation cfg id))) + ((id . ($ )) + `(,(log-rotation + (frequency 'daily) + (files + (map (lambda (ext) + (format #f "/var/log/disfluid/issuer-~a.~a" id ext)) + '("log err"))) + (options '("sharedscripts" "storedir /var/log/disfluid"))))) + ((id . ($ )) + `(,(log-rotation + (frequency 'daily) + (files + (map (lambda (ext) + (format #f "/var/log/disfluid/reverse-proxy-~a.~a" id ext)) + '("log err"))) + (options '("sharedscripts" "storedir /var/log/disfluid"))))) + ((id . ($ )) + `(,(log-rotation + (frequency 'daily) + (files + (map (lambda (ext) + (format #f "/var/log/disfluid/hello-~a.~a" id ext)) + '("log err"))) + (options '("sharedscripts" "storedir /var/log/disfluid"))))) + ((id . ($ )) + `(,(log-rotation + (frequency 'daily) + (files + (map (lambda (ext) + (format #f "/var/log/disfluid/client-service-~a.~a" id ext)) + '("log err"))) + (options '("sharedscripts" "storedir /var/log/disfluid"))))) + ((id . ($ )) + `(,(log-rotation + (frequency 'daily) + (files + (map (lambda (ext) + (format #f "/var/log/disfluid/server-~a.~a" id ext)) + '("log err"))) + (options '("sharedscripts" "storedir /var/log/disfluid"))))) ((items ...) - (apply append (map configuration->log-rotation items))) - (only-one-cfg - (configuration->log-rotation `(default . ,only-one-cfg))))) + (apply append (map configuration->log-rotation items))))) (define-public disfluid-service-type (service-type -- cgit v1.2.3