aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--Makefile2
-rw-r--r--src/org/euandre/packages.scm562
-rw-r--r--src/org/euandre/services.scm562
-rw-r--r--tests/internet/system.scm24
4 files changed, 574 insertions, 576 deletions
diff --git a/Makefile b/Makefile
index 38779c4..6c9369f 100644
--- a/Makefile
+++ b/Makefile
@@ -38,7 +38,7 @@ queue.scm.sentinel: src/org/euandre/queue.scm
packages.scm.sentinel: src/org/euandre/queue.scm src/org/euandre/packages.scm
local.scm.sentinel: src/org/euandre/queue.scm tests/local/system.scm
internet.scm.sentinel: src/org/euandre/queue.scm src/org/euandre/packages.scm \
- src/org/euandre/services.scm tests/internet/system.scm
+ tests/internet/system.scm
queue.scm.sentinel packages.scm.sentinel: Makefile
rm -f `basename $@ .sentinel`*
diff --git a/src/org/euandre/packages.scm b/src/org/euandre/packages.scm
index b609114..6e02c43 100644
--- a/src/org/euandre/packages.scm
+++ b/src/org/euandre/packages.scm
@@ -1,14 +1,124 @@
(define-module (org euandre packages)
#:use-module ((guix licenses) #:prefix licenses:)
+ #:use-module ((ice-9 match) #:prefix m:)
+ #:use-module ((ice-9 textual-ports) #:prefix textual-ports:)
#:use-module ((org euandre queue) #:prefix q:)
+ #:use-module ((srfi srfi-1) #:prefix s1:)
+ #:use-module (gnu)
#:use-module (gnu packages)
#:use-module (gnu packages guile)
#:use-module (gnu packages texinfo)
+ #:use-module (guix build utils)
#:use-module (guix build-system gnu)
#:use-module (guix download)
#:use-module (guix gexp)
+ #:use-module (guix least-authority)
#:use-module (guix packages)
- #:use-module (guix utils))
+ #:use-module (guix records)
+ #:use-module (guix utils)
+ #:export (<syskeep-configuration>
+ syskeep-configuration
+ make-syskeep-configuration
+ syskeep-configuration?
+ syskeep-configuration-package
+ syskeep-configuration-log-file
+
+ <binder-configuration>
+ binder-configuration
+ make-binder-configuration
+ binder-configuration?
+ binder-configuration-name
+ binder-configuration-package
+ binder-configuration-user
+ binder-configuration-group
+ binder-configuration-log-file
+ binder-configuration-data-directory
+ binder-configuration-run-directory
+ binder-configuration-run-in-container?
+ binder-configuration-container-name
+ binder-configuration-extra-mappings
+ binder-configuration-options
+ binder-configuration-listen-socket
+ binder-configuration-upstream-socket
+
+ <glaze-configuration>
+ glaze-configuration
+ make-glaze-configuration
+ glaze-configuration?
+ glaze-configuration-name
+ glaze-configuration-package
+ glaze-configuration-user
+ glaze-configuration-group
+ glaze-configuration-log-file
+ glaze-configuration-data-directory
+ glaze-configuration-run-directory
+ glaze-configuration-run-in-container?
+ glaze-configuration-container-name
+ glaze-configuration-extra-mappings
+ glaze-configuration-options
+ glaze-configuration-listen-socket
+ glaze-configuration-upstream-socket
+
+ <untls-configuration>
+ untls-configuration
+ make-untls-configuration
+ untls-configuration?
+ untls-configuration-name
+ untls-configuration-package
+ untls-configuration-user
+ untls-configuration-group
+ untls-configuration-log-file
+ untls-configuration-data-directory
+ untls-configuration-run-directory
+ untls-configuration-run-in-container?
+ untls-configuration-container-name
+ untls-configuration-extra-mappings
+ untls-configuration-options
+ untls-configuration-listen-socket
+ untls-configuration-upstream-socket
+
+ <wscat-configuration>
+ wscat-configuration
+ make-wscat-configuration
+ wscat-configuration?
+ wscat-configuration-name
+ wscat-configuration-package
+ wscat-configuration-user
+ wscat-configuration-group
+ wscat-configuration-log-file
+ wscat-configuration-data-directory
+ wscat-configuration-run-directory
+ wscat-configuration-run-in-container?
+ wscat-configuration-container-name
+ wscat-configuration-extra-mappings
+ wscat-configuration-options
+ wscat-configuration-listen-socket
+ wscat-configuration-upstream-socket
+
+ <papod-configuration>
+ papod-configuration
+ make-papod-configuration
+ papod-configuration?
+ papod-configuration-name
+ papod-configuration-package
+ papod-configuration-user
+ papod-configuration-group
+ papod-configuration-log-file
+ papod-configuration-data-directory
+ papod-configuration-run-directory
+ papod-configuration-run-in-container?
+ papod-configuration-container-name
+ papod-configuration-extra-mappings
+ papod-configuration-options
+ papod-configuration-listen-socket
+ papod-configuration-upstream-socket))
+(use-package-modules
+ admin
+ version-control)
+(use-service-modules
+ admin
+ mcron
+ shepherd)
@@ -216,6 +326,456 @@
+
+
+
+(define-public (mklist x)
+ (if (not x)
+ '()
+ (if (pair? x)
+ x
+ (list x))))
+
+(define-public (slurp path)
+ (call-with-input-file
+ path
+ textual-ports:get-string-all))
+
+(define-public (str . rest)
+ (apply string-append rest))
+
+(define-public (fmt . rest)
+ (apply format #f rest))
+
+(define-public (user-accounts users)
+ (map (lambda (user)
+ (let ((name (s1:first user))
+ (comment (s1:second user))
+ (groups (s1:third user)))
+ (user-account
+ (name name)
+ (comment comment)
+ (group "users")
+ (supplementary-groups groups))))
+ users))
+
+(define-public (users->keys users)
+ (let ((users-with-keys (filter (compose not null? cdddr)
+ users)))
+ (append
+ (map (lambda (user)
+ (let ((name (s1:first user))
+ (key (s1:fourth user)))
+ `(,name ,(plain-file (str name "-id_rsa.pub") key))))
+ users-with-keys)
+ `(("git" ,@(map (lambda (user)
+ (let ((name (s1:first user))
+ (key (s1:fourth user)))
+ (plain-file (str name "-git-id_rsa.pub")
+ (slurp key))))
+ users-with-keys))))))
+
+(define (tuple->entry tuple)
+ (let* ((name (s1:first tuple))
+ (package (s1:second tuple))
+ (path (string-append "/etc/" name)))
+ (list
+ name
+ (computed-file
+ (string-append "syskeep-" name)
+ #~(begin
+ (use-modules
+ ((ice-9 textual-ports) #:prefix textual-ports:))
+
+ (define (slurp p)
+ (call-with-input-file p textual-ports:get-string-all))
+
+ (define (spit p s)
+ (call-with-output-file
+ p
+ (lambda (port)
+ (display s port))))
+
+ (spit #$output
+ (slurp #$(file-append package path))))))))
+
+(define (etc-entries package paths)
+ (map
+ tuple->entry
+ (map (lambda (path)
+ (list path package))
+ paths)))
+
+(define-public (package-set symbols records)
+ (append
+ records
+ (map
+ (compose list specification->package+output symbol->string)
+ symbols)))
+
+(define-public skeletons
+ (etc-entries
+ syskeep
+ '(".profile")))
+
+(define-public base-services
+ (modify-services %base-services
+ (rottlog-service-type config =>
+ (rottlog-configuration
+ (inherit config)
+ (rc-file
+ (file-append q:rottlog-mailutils-sendmail "/etc/rc"))))))
+
+
+
+(define-record-type* <syskeep-configuration>
+ syskeep-configuration
+ make-syskeep-configuration
+ syskeep-configuration?
+ (package syskeep-configuration-package (default syskeep))
+ (log-file syskeep-configuration-log-file (default "/var/log/cronjobs/cronjobs.log")))
+
+(define (syskeep-profile config)
+ (match-record config <syskeep-configuration>
+ (package)
+ (package-set
+ '(parted
+ guile-heredoc
+ acl
+ bind:utils
+ knot:tools
+ file
+ git
+ lsof
+ moreutils
+ mailutils-sendmail
+ curl
+ make
+ borg
+ rsync
+ sqlite
+ strace
+ rlwrap
+ trash-cli
+ tree)
+ (list
+ package))))
+
+(define (syskeep-rotations config)
+ (match-record config <syskeep-configuration>
+ (log-file)
+ (list
+ (log-rotation
+ (frequency 'weekly)
+ (files (list log-file))
+ (options '("rotate 52"))))))
+
+(define (syskeep-cronjobs config)
+ (match-record config <syskeep-configuration>
+ ()
+ (list
+ #~(job "0 0 * * *" "cronjob check")
+ #~(job "0 1 * * *" "cronjob env BORG_REPO=/mnt/backup/borg backup -q cron")
+ #~(job "0 2 * * *" "cronjob backup -q cron")
+ #~(job "0 3 * * 0" "cronjob gc")
+ #~(job "0 4 * * *" "cronjob reconfigure -U"))))
+
+(define (syskeep-etc-files config)
+ (match-record config <syskeep-configuration>
+ (package)
+ (etc-entries
+ package
+ '("rc.sh"
+ "known_hosts"
+ "ssh.conf"
+ "init.scm"
+ "gitconfig"))))
+
+(define (syskeep-accounts config)
+ (match-record config <syskeep-configuration>
+ ()
+ (list
+ (user-account
+ (name "git")
+ (group "git")
+ (system? #t)
+ (comment "External SSH Git user")
+ (home-directory "/src/ĝit")
+ (create-home-directory? #f)
+ (shell
+ (file-append git "/bin/git-shell")))
+ (user-group
+ (name "git")
+ (system? #t)))))
+
+(define-public syskeep-service-type
+ (service-type
+ (name 'syskeep)
+ (extensions
+ (list
+ (service-extension rottlog-service-type
+ syskeep-rotations)
+ (service-extension mcron-service-type
+ syskeep-cronjobs)
+ (service-extension etc-service-type
+ syskeep-etc-files)
+ (service-extension account-service-type
+ syskeep-accounts)
+ (service-extension profile-service-type
+ syskeep-profile)))
+ (default-value (syskeep-configuration))
+ (description "Common configuration of maintained servers.")))
+
+
+
+(define-record-type* <binder-configuration>
+ binder-configuration
+ make-binder-configuration
+ binder-configuration?
+ (name binder-configuration-name (default "binder"))
+ (package binder-configuration-package (default binder))
+ (user binder-configuration-user (default "binder"))
+ (group binder-configuration-group (default "binder"))
+ (log-file binder-configuration-log-file (default "/var/log/binder/binder.log"))
+ (data-directory binder-configuration-data-directory (default #f))
+ (run-directory binder-configuration-run-directory (default "/var/run/binder"))
+ (run-in-container? binder-configuration-run-in-container? (default #t))
+ (container-name binder-configuration-container-name (default "binder-container"))
+ (extra-mappings binder-configuration-extra-mappings (default '()))
+ (options binder-configuration-options (default '()))
+ (listen-socket binder-configuration-listen-socket (default "0.0.0.0:4443"))
+ (upstream-socket binder-configuration-upstream-socket (default "/var/run/untls/untls.socket")))
+
+(define-record-type* <glaze-configuration>
+ glaze-configuration
+ make-glaze-configuration
+ glaze-configuration?
+ (name glaze-configuration-name (default "glaze"))
+ (package glaze-configuration-package (default glaze))
+ (user glaze-configuration-user (default "glaze"))
+ (group glaze-configuration-group (default "glaze"))
+ (log-file glaze-configuration-log-file (default "/var/log/glaze/glaze.log"))
+ (data-directory glaze-configuration-data-directory (default #f))
+ (run-directory glaze-configuration-run-directory (default "/var/run/glaze"))
+ (run-in-container? glaze-configuration-run-in-container? (default #t))
+ (container-name glaze-configuration-container-name (default "glaze-container"))
+ (extra-mappings glaze-configuration-extra-mappings (default '()))
+ (options glaze-configuration-options (default '()))
+ (listen-socket glaze-configuration-listen-socket (default "/var/run/glaze/glaze.socket"))
+ (upstream-socket glaze-configuration-upstream-socket (default #f)))
+
+(define-record-type* <untls-configuration>
+ untls-configuration
+ make-untls-configuration
+ untls-configuration?
+ (name untls-configuration-name (default "untls"))
+ (package untls-configuration-package (default untls))
+ (user untls-configuration-user (default "untls"))
+ (group untls-configuration-group (default "untls"))
+ (log-file untls-configuration-log-file (default "/var/log/untls/untls.log"))
+ (data-directory untls-configuration-data-directory (default #f))
+ (run-directory untls-configuration-run-directory (default "/var/run/untls"))
+ (run-in-container? untls-configuration-run-in-container? (default #t))
+ (container-name untls-configuration-container-name (default "untls-container"))
+ (extra-mappings untls-configuration-extra-mappings (default '()))
+ (options untls-configuration-options (default '()))
+ (listen-socket untls-configuration-listen-socket (default "/var/run/untls/untls.socket"))
+ (upstream-socket untls-configuration-upstream-socket (default #f)))
+
+(define-record-type* <wscat-configuration>
+ wscat-configuration
+ make-wscat-configuration
+ wscat-configuration?
+ (name wscat-configuration-name (default "wscat"))
+ (package wscat-configuration-package (default wscat))
+ (user wscat-configuration-user (default "wscat"))
+ (group wscat-configuration-group (default "wscat"))
+ (log-file wscat-configuration-log-file (default "/var/log/wscat/wscat.log"))
+ (data-directory wscat-configuration-data-directory (default #f))
+ (run-directory wscat-configuration-run-directory (default "/var/run/wscat"))
+ (run-in-container? wscat-configuration-run-in-container? (default #t))
+ (container-name wscat-configuration-container-name (default "wscat-container"))
+ (extra-mappings wscat-configuration-extra-mappings (default '()))
+ (options wscat-configuration-options (default '()))
+ (listen-socket wscat-configuration-listen-socket (default "/var/run/wscat/wscat.socket"))
+ (upstream-socket wscat-configuration-upstream-socket (default #f)))
+
+(define-record-type* <papod-configuration>
+ papod-configuration
+ make-papod-configuration
+ papod-configuration?
+ (name papod-configuration-name (default "papod"))
+ (package papod-configuration-package (default papod))
+ (user papod-configuration-user (default "papod"))
+ (group papod-configuration-group (default "papod"))
+ (log-file papod-configuration-log-file (default "/var/log/papod/papod.log"))
+ (data-directory papod-configuration-data-directory (default "/var/lib/papod"))
+ (run-directory papod-configuration-run-directory (default "/var/run/papod"))
+ (run-in-container? papod-configuration-run-in-container? (default #t))
+ (container-name papod-configuration-container-name (default "papod-container"))
+ (extra-mappings papod-configuration-extra-mappings (default '()))
+ (options papod-configuration-options (default '()))
+ (listen-socket papod-configuration-listen-socket (default #f))
+ (upstream-socket papod-configuration-upstream-socket (default #f)))
+
+(define-public (profile-for type)
+ (lambda (config)
+ (m:match config
+ (($ type _name package)
+ (list package)))))
+
+(define-public (rotations-for type)
+ (lambda (config)
+ (m:match config
+ (($ type _name _package _user _group log-file)
+ (list
+ (log-rotation
+ (frequency 'weekly)
+ (files (list log-file))
+ (options '("rotate 5200"))))))))
+
+(define-public (activation-for type)
+ (lambda (config)
+ (m:match config
+ (($ type name _package user _group log-file data-directory run-directory)
+ #~(begin
+ (use-modules (guix build utils))
+ (when #$log-file
+ (format (current-error-port)
+ "Creating ~a log directory for '~a'.~%" #$name #$log-file)
+ (mkdir-p (dirname #$log-file))
+ (when (not (file-exists? #$log-file))
+ (call-with-output-file #$log-file (const #t)))
+ (chmod #$log-file #o644))
+ (let ((user (getpwnam #$user)))
+ (when #$data-directory
+ (format (current-error-port)
+ "Creating ~a data directory '~a'.~%" #$name #$data-directory)
+ (mkdir-p #$data-directory)
+ (chown #$data-directory (passwd:uid user) (passwd:gid user))
+ (chmod #$data-directory #o750))
+ (when #$run-directory
+ (format (current-error-port)
+ "Creating ~a run directory '~a'.~%" #$name #$run-directory)
+ (mkdir-p #$run-directory)
+ (chown #$run-directory (passwd:uid user) (passwd:gid user))
+ (chmod #$run-directory #o755))))))))
+
+(define-public (accounts-for type)
+ (lambda (config)
+ (m:match config
+ (($ type name _package user group)
+ (list
+ (user-group
+ (name group)
+ (system? #t))
+ (user-account
+ (name user)
+ (group group)
+ (system? #t)
+ (comment (format #f "The user for runtime execution of ~a code" name))
+ (home-directory "/var/empty")
+ (shell
+ (file-append shadow "/sbin/nologin"))))))))
+
+(define-public (cmd-for type config)
+ (m:match config
+ (($ type name package user group _log-file data-directory _run-directory
+ run-in-container? container-name extra-mappings)
+ (let ((bin (file-append package (string-append "/bin/" name))))
+ (if (not run-in-container?)
+ bin
+ (least-authority-wrapper
+ bin
+ #:user user
+ #:group group
+ #:name container-name
+ #:directory (or data-directory "/")
+ #:preserved-environment-variables
+ '()
+ #:mappings
+ (append
+ (mklist
+ (and data-directory
+ (file-system-mapping
+ (source data-directory)
+ (target source)
+ (writable? #t))))
+ extra-mappings)))))))
+
+(define-public (shepherd-services-for type)
+ (lambda (config)
+ (m:match config
+ (($ type name _package user group log-file data-directory _run-directory
+ _run-in-container? _container-name _extra-mappings options
+ listen-socket upstream-socket)
+ (list
+ (shepherd-service
+ (provision (list (string->symbol name)))
+ (requirement '())
+ (start
+ #~(make-forkexec-constructor ;; FIXME: add #:resource-limits
+ (list #$(cmd-for type config)
+ #$@options
+ #$@(mklist listen-socket)
+ #$@(mklist upstream-socket))
+ #:user #$user
+ #:group #$group
+ #:log-file #$log-file
+ #:directory #$data-directory))
+ (stop #~(make-kill-destructor SIGKILL))
+ (documentation
+ (fmt "The Shepherd service that runs the server via \"~a\"." name))))))))
+
+(define-public (service-type-for name type config extensions)
+ (service-type
+ (name name)
+ (extensions
+ (append
+ (list
+ (service-extension shepherd-root-service-type
+ (shepherd-services-for type))
+ (service-extension profile-service-type
+ (profile-for type))
+ (service-extension activation-service-type
+ (activation-for type))
+ (service-extension account-service-type
+ (accounts-for type))
+ (service-extension rottlog-service-type
+ (rotations-for type)))
+ extensions))
+ (default-value config)
+ (description
+ (fmt "The top-level generic system service, generated for ~a code.
+
+It includes:
+- the Shepherd service for starting, stopping and reloading the service;
+- activation script for setting up the initial directories and permissions;
+- the group and account for running the production service;
+- log management (storage and rotation) for logs produced by the running services.
+
+The default configuration should provide sane values for all of these."
+ name))))
+
+
+
+(define-public binder-service-type
+ (service-type-for 'binder <binder-configuration> (binder-configuration) '()))
+
+(define-public glaze-service-type
+ (service-type-for 'glaze <glaze-configuration> (glaze-configuration) '()))
+
+(define-public untls-service-type
+ (service-type-for 'untls <untls-configuration> (untls-configuration) '()))
+
+(define-public wscat-service-type
+ (service-type-for 'wscat <wscat-configuration> (wscat-configuration) '()))
+
+(define-public papod-service-type
+ (service-type-for 'papod <papod-configuration> (papod-configuration) '()))
+
+
+
(list
remembering
eut
diff --git a/src/org/euandre/services.scm b/src/org/euandre/services.scm
deleted file mode 100644
index d38110c..0000000
--- a/src/org/euandre/services.scm
+++ /dev/null
@@ -1,562 +0,0 @@
-(define-module (org euandre services)
- #:use-module ((org euandre packages) #:prefix pkg:)
- #:use-module ((org euandre queue) #:prefix q:)
- #:use-module ((ice-9 match) #:prefix m:)
- #:use-module ((ice-9 popen) #:prefix popen:)
- #:use-module ((ice-9 textual-ports) #:prefix textual-ports:)
- #:use-module ((gnu build linux-container) #:prefix container:)
- #:use-module ((srfi srfi-1) #:prefix s1:)
- #:use-module (gnu)
- #:use-module (guix build utils)
- #:use-module (guix least-authority)
- #:use-module (guix records)
- #:export (<syskeep-configuration>
- syskeep-configuration
- make-syskeep-configuration
- syskeep-configuration?
- syskeep-configuration-package
- syskeep-configuration-log-file
-
- <binder-configuration>
- binder-configuration
- make-binder-configuration
- binder-configuration?
- binder-configuration-name
- binder-configuration-package
- binder-configuration-user
- binder-configuration-group
- binder-configuration-log-file
- binder-configuration-data-directory
- binder-configuration-run-directory
- binder-configuration-run-in-container?
- binder-configuration-container-name
- binder-configuration-extra-mappings
- binder-configuration-options
- binder-configuration-listen-socket
- binder-configuration-upstream-socket
-
- <glaze-configuration>
- glaze-configuration
- make-glaze-configuration
- glaze-configuration?
- glaze-configuration-name
- glaze-configuration-package
- glaze-configuration-user
- glaze-configuration-group
- glaze-configuration-log-file
- glaze-configuration-data-directory
- glaze-configuration-run-directory
- glaze-configuration-run-in-container?
- glaze-configuration-container-name
- glaze-configuration-extra-mappings
- glaze-configuration-options
- glaze-configuration-listen-socket
- glaze-configuration-upstream-socket
-
- <untls-configuration>
- untls-configuration
- make-untls-configuration
- untls-configuration?
- untls-configuration-name
- untls-configuration-package
- untls-configuration-user
- untls-configuration-group
- untls-configuration-log-file
- untls-configuration-data-directory
- untls-configuration-run-directory
- untls-configuration-run-in-container?
- untls-configuration-container-name
- untls-configuration-extra-mappings
- untls-configuration-options
- untls-configuration-listen-socket
- untls-configuration-upstream-socket
-
- <wscat-configuration>
- wscat-configuration
- make-wscat-configuration
- wscat-configuration?
- wscat-configuration-name
- wscat-configuration-package
- wscat-configuration-user
- wscat-configuration-group
- wscat-configuration-log-file
- wscat-configuration-data-directory
- wscat-configuration-run-directory
- wscat-configuration-run-in-container?
- wscat-configuration-container-name
- wscat-configuration-extra-mappings
- wscat-configuration-options
- wscat-configuration-listen-socket
- wscat-configuration-upstream-socket
-
- <papod-configuration>
- papod-configuration
- make-papod-configuration
- papod-configuration?
- papod-configuration-name
- papod-configuration-package
- papod-configuration-user
- papod-configuration-group
- papod-configuration-log-file
- papod-configuration-data-directory
- papod-configuration-run-directory
- papod-configuration-run-in-container?
- papod-configuration-container-name
- papod-configuration-extra-mappings
- papod-configuration-options
- papod-configuration-listen-socket
- papod-configuration-upstream-socket))
-(use-package-modules
- admin
- version-control)
-(use-service-modules
- admin
- mcron
- shepherd)
-
-
-
-(define-public (mklist x)
- (if (not x)
- '()
- (if (pair? x)
- x
- (list x))))
-
-(define-public (slurp path)
- (call-with-input-file
- path
- textual-ports:get-string-all))
-
-(define-public (str . rest)
- (apply string-append rest))
-
-(define-public (fmt . rest)
- (apply format #f rest))
-
-(define-public (user-accounts users)
- (map (lambda (user)
- (let ((name (s1:first user))
- (comment (s1:second user))
- (groups (s1:third user)))
- (user-account
- (name name)
- (comment comment)
- (group "users")
- (supplementary-groups groups))))
- users))
-
-(define-public (users->keys users)
- (let ((users-with-keys (filter (compose not null? cdddr)
- users)))
- (append
- (map (lambda (user)
- (let ((name (s1:first user))
- (key (s1:fourth user)))
- `(,name ,(plain-file (str name "-id_rsa.pub") key))))
- users-with-keys)
- `(("git" ,@(map (lambda (user)
- (let ((name (s1:first user))
- (key (s1:fourth user)))
- (plain-file (str name "-git-id_rsa.pub")
- (slurp key))))
- users-with-keys))))))
-
-(define (tuple->entry tuple)
- (let* ((name (s1:first tuple))
- (package (s1:second tuple))
- (path (string-append "/etc/" name)))
- (list
- name
- (computed-file
- (string-append "syskeep-" name)
- #~(begin
- (use-modules
- ((ice-9 textual-ports) #:prefix textual-ports:))
-
- (define (slurp p)
- (call-with-input-file p textual-ports:get-string-all))
-
- (define (spit p s)
- (call-with-output-file
- p
- (lambda (port)
- (display s port))))
-
- (spit #$output
- (slurp #$(file-append package path))))))))
-
-(define (etc-entries package paths)
- (map
- tuple->entry
- (map (lambda (path)
- (list path package))
- paths)))
-
-(define-public (package-set symbols records)
- (append
- records
- (map
- (compose list specification->package+output symbol->string)
- symbols)))
-
-(define-public skeletons
- (etc-entries
- pkg:syskeep
- '(".profile")))
-
-(define-public base-services
- (modify-services %base-services
- (rottlog-service-type config =>
- (rottlog-configuration
- (inherit config)
- (rc-file
- (file-append q:rottlog-mailutils-sendmail "/etc/rc"))))))
-
-
-
-(define-record-type* <syskeep-configuration>
- syskeep-configuration
- make-syskeep-configuration
- syskeep-configuration?
- (package syskeep-configuration-package (default pkg:syskeep))
- (log-file syskeep-configuration-log-file (default "/var/log/cronjobs/cronjobs.log")))
-
-(define (syskeep-profile config)
- (match-record config <syskeep-configuration>
- (package)
- (package-set
- '(parted
- guile-heredoc
- acl
- bind:utils
- knot:tools
- file
- git
- lsof
- moreutils
- mailutils-sendmail
- curl
- make
- borg
- rsync
- sqlite
- strace
- rlwrap
- trash-cli
- tree)
- (list
- package))))
-
-(define (syskeep-rotations config)
- (match-record config <syskeep-configuration>
- (log-file)
- (list
- (log-rotation
- (frequency 'weekly)
- (files (list log-file))
- (options '("rotate 52"))))))
-
-(define (syskeep-cronjobs config)
- (match-record config <syskeep-configuration>
- ()
- (list
- #~(job "0 0 * * *" "cronjob check")
- #~(job "0 1 * * *" "cronjob env BORG_REPO=/mnt/backup/borg backup -q cron")
- #~(job "0 2 * * *" "cronjob backup -q cron")
- #~(job "0 3 * * 0" "cronjob gc")
- #~(job "0 4 * * *" "cronjob reconfigure -U"))))
-
-(define (syskeep-etc-files config)
- (match-record config <syskeep-configuration>
- (package)
- (etc-entries
- package
- '("rc.sh"
- "known_hosts"
- "ssh.conf"
- "init.scm"
- "gitconfig"))))
-
-(define (syskeep-accounts config)
- (match-record config <syskeep-configuration>
- ()
- (list
- (user-account
- (name "git")
- (group "git")
- (system? #t)
- (comment "External SSH Git user")
- (home-directory "/src/ĝit")
- (create-home-directory? #f)
- (shell
- (file-append git "/bin/git-shell")))
- (user-group
- (name "git")
- (system? #t)))))
-
-(define-public syskeep-service-type
- (service-type
- (name 'syskeep)
- (extensions
- (list
- (service-extension rottlog-service-type
- syskeep-rotations)
- (service-extension mcron-service-type
- syskeep-cronjobs)
- (service-extension etc-service-type
- syskeep-etc-files)
- (service-extension account-service-type
- syskeep-accounts)
- (service-extension profile-service-type
- syskeep-profile)))
- (default-value (syskeep-configuration))
- (description "Common configuration of maintained servers.")))
-
-
-
-(define-record-type* <binder-configuration>
- binder-configuration
- make-binder-configuration
- binder-configuration?
- (name binder-configuration-name (default "binder"))
- (package binder-configuration-package (default pkg:binder))
- (user binder-configuration-user (default "binder"))
- (group binder-configuration-group (default "binder"))
- (log-file binder-configuration-log-file (default "/var/log/binder/binder.log"))
- (data-directory binder-configuration-data-directory (default #f))
- (run-directory binder-configuration-run-directory (default "/var/run/binder"))
- (run-in-container? binder-configuration-run-in-container? (default #t))
- (container-name binder-configuration-container-name (default "binder-container"))
- (extra-mappings binder-configuration-extra-mappings (default '()))
- (options binder-configuration-options (default '()))
- (listen-socket binder-configuration-listen-socket (default "0.0.0.0:4443"))
- (upstream-socket binder-configuration-upstream-socket (default "/var/run/untls/untls.socket")))
-
-(define-record-type* <glaze-configuration>
- glaze-configuration
- make-glaze-configuration
- glaze-configuration?
- (name glaze-configuration-name (default "glaze"))
- (package glaze-configuration-package (default pkg:glaze))
- (user glaze-configuration-user (default "glaze"))
- (group glaze-configuration-group (default "glaze"))
- (log-file glaze-configuration-log-file (default "/var/log/glaze/glaze.log"))
- (data-directory glaze-configuration-data-directory (default #f))
- (run-directory glaze-configuration-run-directory (default "/var/run/glaze"))
- (run-in-container? glaze-configuration-run-in-container? (default #t))
- (container-name glaze-configuration-container-name (default "glaze-container"))
- (extra-mappings glaze-configuration-extra-mappings (default '()))
- (options glaze-configuration-options (default '()))
- (listen-socket glaze-configuration-listen-socket (default "/var/run/glaze/glaze.socket"))
- (upstream-socket glaze-configuration-upstream-socket (default #f)))
-
-(define-record-type* <untls-configuration>
- untls-configuration
- make-untls-configuration
- untls-configuration?
- (name untls-configuration-name (default "untls"))
- (package untls-configuration-package (default pkg:untls))
- (user untls-configuration-user (default "untls"))
- (group untls-configuration-group (default "untls"))
- (log-file untls-configuration-log-file (default "/var/log/untls/untls.log"))
- (data-directory untls-configuration-data-directory (default #f))
- (run-directory untls-configuration-run-directory (default "/var/run/untls"))
- (run-in-container? untls-configuration-run-in-container? (default #t))
- (container-name untls-configuration-container-name (default "untls-container"))
- (extra-mappings untls-configuration-extra-mappings (default '()))
- (options untls-configuration-options (default '()))
- (listen-socket untls-configuration-listen-socket (default "/var/run/untls/untls.socket"))
- (upstream-socket untls-configuration-upstream-socket (default #f)))
-
-(define-record-type* <wscat-configuration>
- wscat-configuration
- make-wscat-configuration
- wscat-configuration?
- (name wscat-configuration-name (default "wscat"))
- (package wscat-configuration-package (default pkg:wscat))
- (user wscat-configuration-user (default "wscat"))
- (group wscat-configuration-group (default "wscat"))
- (log-file wscat-configuration-log-file (default "/var/log/wscat/wscat.log"))
- (data-directory wscat-configuration-data-directory (default #f))
- (run-directory wscat-configuration-run-directory (default "/var/run/wscat"))
- (run-in-container? wscat-configuration-run-in-container? (default #t))
- (container-name wscat-configuration-container-name (default "wscat-container"))
- (extra-mappings wscat-configuration-extra-mappings (default '()))
- (options wscat-configuration-options (default '()))
- (listen-socket wscat-configuration-listen-socket (default "/var/run/wscat/wscat.socket"))
- (upstream-socket wscat-configuration-upstream-socket (default #f)))
-
-(define-record-type* <papod-configuration>
- papod-configuration
- make-papod-configuration
- papod-configuration?
- (name papod-configuration-name (default "papod"))
- (package papod-configuration-package (default pkg:papod))
- (user papod-configuration-user (default "papod"))
- (group papod-configuration-group (default "papod"))
- (log-file papod-configuration-log-file (default "/var/log/papod/papod.log"))
- (data-directory papod-configuration-data-directory (default "/var/lib/papod"))
- (run-directory papod-configuration-run-directory (default "/var/run/papod"))
- (run-in-container? papod-configuration-run-in-container? (default #t))
- (container-name papod-configuration-container-name (default "papod-container"))
- (extra-mappings papod-configuration-extra-mappings (default '()))
- (options papod-configuration-options (default '()))
- (listen-socket papod-configuration-listen-socket (default #f))
- (upstream-socket papod-configuration-upstream-socket (default #f)))
-
-(define-public (profile-for type)
- (lambda (config)
- (m:match config
- (($ type _name package)
- (list package)))))
-
-(define-public (rotations-for type)
- (lambda (config)
- (m:match config
- (($ type _name _package _user _group log-file)
- (list
- (log-rotation
- (frequency 'weekly)
- (files (list log-file))
- (options '("rotate 5200"))))))))
-
-(define-public (activation-for type)
- (lambda (config)
- (m:match config
- (($ type name _package user _group log-file data-directory run-directory)
- #~(begin
- (use-modules (guix build utils))
- (when #$log-file
- (format (current-error-port)
- "Creating ~a log directory for '~a'.~%" #$name #$log-file)
- (mkdir-p (dirname #$log-file))
- (when (not (file-exists? #$log-file))
- (call-with-output-file #$log-file (const #t)))
- (chmod #$log-file #o644))
- (let ((user (getpwnam #$user)))
- (when #$data-directory
- (format (current-error-port)
- "Creating ~a data directory '~a'.~%" #$name #$data-directory)
- (mkdir-p #$data-directory)
- (chown #$data-directory (passwd:uid user) (passwd:gid user))
- (chmod #$data-directory #o750))
- (when #$run-directory
- (format (current-error-port)
- "Creating ~a run directory '~a'.~%" #$name #$run-directory)
- (mkdir-p #$run-directory)
- (chown #$run-directory (passwd:uid user) (passwd:gid user))
- (chmod #$run-directory #o755))))))))
-
-(define-public (accounts-for type)
- (lambda (config)
- (m:match config
- (($ type name _package user group)
- (list
- (user-group
- (name group)
- (system? #t))
- (user-account
- (name user)
- (group group)
- (system? #t)
- (comment (format #f "The user for runtime execution of ~a code" name))
- (home-directory "/var/empty")
- (shell
- (file-append shadow "/sbin/nologin"))))))))
-
-(define-public (cmd-for type config)
- (m:match config
- (($ type name package user group _log-file data-directory _run-directory
- run-in-container? container-name extra-mappings)
- (let ((bin (file-append package (string-append "/bin/" name))))
- (if (not run-in-container?)
- bin
- (least-authority-wrapper
- bin
- #:user user
- #:group group
- #:name container-name
- #:directory (or data-directory "/")
- #:preserved-environment-variables
- '()
- #:mappings
- (append
- (mklist
- (and data-directory
- (file-system-mapping
- (source data-directory)
- (target source)
- (writable? #t))))
- extra-mappings)))))))
-
-(define-public (shepherd-services-for type)
- (lambda (config)
- (m:match config
- (($ type name _package user group log-file data-directory _run-directory
- _run-in-container? _container-name _extra-mappings options
- listen-socket upstream-socket)
- (list
- (shepherd-service
- (provision (list (string->symbol name)))
- (requirement '())
- (start
- #~(make-forkexec-constructor ;; FIXME: add #:resource-limits
- (list #$(cmd-for type config)
- #$@options
- #$@(mklist listen-socket)
- #$@(mklist upstream-socket))
- #:user #$user
- #:group #$group
- #:log-file #$log-file
- #:directory #$data-directory))
- (stop #~(make-kill-destructor SIGKILL))
- (documentation
- (fmt "The Shepherd service that runs the server via \"~a\"." name))))))))
-
-(define-public (service-type-for name type config extensions)
- (service-type
- (name name)
- (extensions
- (append
- (list
- (service-extension shepherd-root-service-type
- (shepherd-services-for type))
- (service-extension profile-service-type
- (profile-for type))
- (service-extension activation-service-type
- (activation-for type))
- (service-extension account-service-type
- (accounts-for type))
- (service-extension rottlog-service-type
- (rotations-for type)))
- extensions))
- (default-value config)
- (description
- (fmt "The top-level generic system service, generated for ~a code.
-
-It includes:
-- the Shepherd service for starting, stopping and reloading the service;
-- activation script for setting up the initial directories and permissions;
-- the group and account for running the production service;
-- log management (storage and rotation) for logs produced by the running services.
-
-The default configuration should provide sane values for all of these."
- name))))
-
-
-
-(define-public binder-service-type
- (service-type-for 'binder <binder-configuration> (binder-configuration) '()))
-
-(define-public glaze-service-type
- (service-type-for 'glaze <glaze-configuration> (glaze-configuration) '()))
-
-(define-public untls-service-type
- (service-type-for 'untls <untls-configuration> (untls-configuration) '()))
-
-(define-public wscat-service-type
- (service-type-for 'wscat <wscat-configuration> (wscat-configuration) '()))
-
-(define-public papod-service-type
- (service-type-for 'papod <papod-configuration> (papod-configuration) '()))
diff --git a/tests/internet/system.scm b/tests/internet/system.scm
index c0e5986..84471d2 100644
--- a/tests/internet/system.scm
+++ b/tests/internet/system.scm
@@ -1,6 +1,6 @@
(use-modules
((org euandre queue) #:prefix q:)
- ((org euandre services) #:prefix serv:)
+ ((org euandre packages) #:prefix pkg:)
(gnu))
(use-package-modules)
(use-service-modules
@@ -12,7 +12,7 @@
ssh)
(define (path s)
- (serv:str (dirname (dirname (dirname (current-filename)))) "/" s))
+ (pkg:str (dirname (dirname (dirname (current-filename)))) "/" s))
(define +users+
`(("user1" "I'm a user" ())
@@ -20,30 +20,30 @@
(operating-system
(host-name "a-internet-test-host")
- (skeletons serv:skeletons)
- (users (append (serv:user-accounts +users+) %base-user-accounts))
+ (skeletons pkg:skeletons)
+ (users (append (pkg:user-accounts +users+) %base-user-accounts))
(services
(append
(list
(service ntp-service-type)
(service dhcp-client-service-type)
(service fail2ban-service-type)
- (service serv:binder-service-type)
- (service serv:glaze-service-type)
- (service serv:untls-service-type)
- (service serv:wscat-service-type)
- (service serv:papod-service-type)
- (service openssh-service-type (q:openssh-default-configuration (serv:users->keys +users+)))
+ (service pkg:binder-service-type)
+ (service pkg:glaze-service-type)
+ (service pkg:untls-service-type)
+ (service pkg:wscat-service-type)
+ (service pkg:papod-service-type)
+ (service openssh-service-type (q:openssh-default-configuration (pkg:users->keys +users+)))
(service certbot-service-type (q:tld-certbot-configuration "tld.local"))
(service cgit-service-type q:cgit-pre-configuration)
- (service serv:syskeep-service-type)
+ (service pkg:syskeep-service-type)
(service q:shadow-group-service-type)
(service q:dkimproxyout-service-type)
(service q:cyrus-sasl-service-type)
(service q:dovecot-service-type)
(service q:internet-postfix-service-type)
(service mail-aliases-service-type '()))
- serv:base-services))
+ pkg:base-services))
(bootloader
(bootloader-configuration
(bootloader grub-bootloader)))
generated by cgit v1.2.3 (git 2.49.0) at 2025-07-13 12:47:10 +0000