From 060204c29e63821fbf4e2baab143302a2f8d8ca1 Mon Sep 17 00:00:00 2001 From: Hilton Chain Date: Tue, 8 Aug 2023 13:08:09 +0800 Subject: [PATCH] services: Use match-record. * rosenthal/services/bittorrent.scm (qbittorrent-configuration)[qbittorrent]: Change field type to file-like. (qbittorrent-activation,qbittorrent-shepherd-service): Use match-record-lambda * rosenthal/services/child-error.scm (miniflux-configuration)[miniflux], (cloudflare-tunnel-configuration)[cloudflared]: Change field type to file-like (clash-activation,clash-shepherd-service,cloudflare-tunnel-shepherd-service) (cloudflare-warp-shepherd-service,miniflux-shepherd-service) (home-wakapi-shepherd-service,home-socks2http-shepherd-service): Use match-record-lambda. * rosenthal/services/dns.scm (smartdns-configuration)[smartdns]: Change field type to file-like. (smartdns-shepherd-service): Use match-record-lambda. * rosenthal/services/networking.scm (iwd-configuration)[iwd]: Change field type to file-like. (iwd-shepherd-service,iwd-etc-service): Use match-record-lambda. --- rosenthal/services/bittorrent.scm | 30 ++--- rosenthal/services/child-error.scm | 188 ++++++++++++++--------------- rosenthal/services/dns.scm | 15 +-- rosenthal/services/networking.scm | 62 +++++----- 4 files changed, 146 insertions(+), 149 deletions(-) diff --git a/rosenthal/services/bittorrent.scm b/rosenthal/services/bittorrent.scm index 2ae7e5b..a53dca9 100644 --- a/rosenthal/services/bittorrent.scm +++ b/rosenthal/services/bittorrent.scm @@ -4,7 +4,6 @@ (define-module (rosenthal services bittorrent) #:use-module (guix gexp) - #:use-module (guix packages) #:use-module (guix records) #:use-module (gnu packages admin) #:use-module (gnu packages bittorrent) @@ -20,9 +19,9 @@ ;; -(define-configuration/no-serialization qbittorrent-configuration +(define-configuration qbittorrent-configuration (qbittorrent - (package qbittorrent-nox) + (file-like qbittorrent-nox) "The qBittorrent package to use, we need @command{qbittorrent-nox}.") (log-file (string "/var/log/qbittorrent.log") @@ -35,7 +34,8 @@ "Directory to store configuration files in.") (extra-options (list-of-strings '()) - "List of extra options.")) + "List of extra options.") + (no-serialization)) (define %qbittorrent-accounts (list (user-group (name "qbittorrent") (system? #t)) @@ -47,17 +47,19 @@ (home-directory "/var/empty") (shell (file-append shadow "/sbin/nologin"))))) -(define (qbittorrent-activation config) - #~(begin - (use-modules (guix build utils)) - (let ((profile-directory #$(qbittorrent-configuration-profile-directory config)) - (user (getpwnam "qbittorrent"))) - (mkdir-p profile-directory) - (chown profile-directory (passwd:uid user) (passwd:gid user))))) +(define qbittorrent-activation + (match-record-lambda + (qbittorrent log-file webui-port profile-directory extra-options) + #~(begin + (use-modules (guix build utils)) + (let ((profile-directory #$profile-directory) + (user (getpwnam "qbittorrent"))) + (mkdir-p profile-directory) + (chown profile-directory (passwd:uid user) (passwd:gid user)))))) -(define (qbittorrent-shepherd-service config) - (match-record config - (qbittorrent log-file webui-port profile-directory extra-options) +(define qbittorrent-shepherd-service + (match-record-lambda + (qbittorrent log-file webui-port profile-directory extra-options) (list (shepherd-service (documentation "Run qbittorrent.") (provision '(qbittorrent)) diff --git a/rosenthal/services/child-error.scm b/rosenthal/services/child-error.scm index 0285c75..ceffd04 100644 --- a/rosenthal/services/child-error.scm +++ b/rosenthal/services/child-error.scm @@ -3,10 +3,8 @@ ;; SPDX-License-Identifier: GPL-3.0-or-later (define-module (rosenthal services child-error) - #:use-module (ice-9 match) #:use-module (guix records) #:use-module (guix gexp) - #:use-module (guix packages) #:use-module (gnu home services) #:use-module (gnu home services shepherd) #:use-module (gnu packages admin) @@ -37,16 +35,12 @@ home-socks2http-configuration home-socks2http-service-type)) -;; Child-error: services for packages not available in Guix, currently this -;; means some Go and Rust apps I build locally but don't want to package. - - ;; ;; Clash ;; -(define-configuration/no-serialization clash-configuration +(define-configuration clash-configuration (clash (file-like clash-bin) "The clash package.") @@ -58,7 +52,8 @@ "Where to store data.") (config (file-like (plain-file "empty" "")) - "Clash configuration file.")) + "Clash configuration file.") + (no-serialization)) (define %clash-accounts (list (user-group (name "clash") (system? #t)) @@ -70,32 +65,32 @@ (shell (file-append shadow "/sbin/nologin"))))) (define clash-activation - (match-lambda - (($ clash log-file data-directory config) - #~(begin - (use-modules (guix build utils)) - (let ((config-dest (string-append #$data-directory "/config.yaml")) - (user (getpwnam "clash"))) - (mkdir-p #$data-directory) - (chown #$data-directory (passwd:uid user) (passwd:gid user)) - (if (file-exists? config-dest) - (delete-file config-dest)) - (symlink #$config config-dest)))))) + (match-record-lambda + (clash log-file data-directory config) + #~(begin + (use-modules (guix build utils)) + (let ((config-dest (string-append #$data-directory "/config.yaml")) + (user (getpwnam "clash"))) + (mkdir-p #$data-directory) + (chown #$data-directory (passwd:uid user) (passwd:gid user)) + (if (file-exists? config-dest) + (delete-file config-dest)) + (symlink #$config config-dest))))) (define clash-shepherd-service - (match-lambda - (($ clash log-file data-directory config) - (list (shepherd-service - (documentation "Run clash.") - (provision '(clash)) - (requirement '(loopback networking)) - (start #~(make-forkexec-constructor - (list #$(file-append clash "/bin/clash") - "-d" #$data-directory) - #:user "clash" - #:group "clash" - #:log-file #$log-file)) - (stop #~(make-kill-destructor))))))) + (match-record-lambda + (clash log-file data-directory config) + (list (shepherd-service + (documentation "Run clash.") + (provision '(clash)) + (requirement '(loopback networking)) + (start #~(make-forkexec-constructor + (list #$(file-append clash "/bin/clash") + "-d" #$data-directory) + #:user "clash" + #:group "clash" + #:log-file #$log-file)) + (stop #~(make-kill-destructor)))))) (define clash-service-type (service-type @@ -110,16 +105,15 @@ (default-value (clash-configuration)) (description "Run Clash."))) - ;; ;; Cloudflare Tunnel ;; -(define-configuration/no-serialization cloudflare-tunnel-configuration +(define-configuration cloudflare-tunnel-configuration (cloudflared - (package cloudflared) + (file-like cloudflared) "The cloudflared executable.") ;; Tunnel options @@ -151,41 +145,39 @@ headers. This can expose sensitive information in your logs.") "Create an experimental post-quantum secure tunnel.") (extra-options (list-of-strings '()) - "List of extra options.")) + "List of extra options.") + (no-serialization)) (define cloudflare-tunnel-shepherd-service - (match-lambda - (($ cloudflared metrics - log-level log-file - extra-tunnel-options - token http2-origin? post-quantum? - extra-options) - (list (shepherd-service - (documentation "Run cloudflared.") - (provision '(cloudflare-tunnel)) - (requirement '(loopback networking)) - (start #~(make-forkexec-constructor - (list #$(file-append cloudflared "/bin/cloudflared") - "tunnel" - "--no-autoupdate" - "--metrics" #$metrics - "--loglevel" #$log-level - #$@extra-tunnel-options - - "run" - #$@(if http2-origin? - '("--http2-origin") - '()) - #$@(if post-quantum? - '("--post-quantum") - '()) - #$@extra-options) - #:user "nobody" - #:group "nogroup" - #:log-file #$log-file - #:environment-variables - (list (format #f "TUNNEL_TOKEN=~a" #$token)))) - (stop #~(make-kill-destructor))))))) + (match-record-lambda + (cloudflared metrics log-level log-file extra-tunnel-options + token http2-origin? post-quantum? extra-options) + (list (shepherd-service + (documentation "Run cloudflared.") + (provision '(cloudflare-tunnel)) + (requirement '(loopback networking)) + (start #~(make-forkexec-constructor + (list #$(file-append cloudflared "/bin/cloudflared") + "tunnel" + "--no-autoupdate" + "--metrics" #$metrics + "--loglevel" #$log-level + #$@extra-tunnel-options + + "run" + #$@(if http2-origin? + '("--http2-origin") + '()) + #$@(if post-quantum? + '("--post-quantum") + '()) + #$@extra-options) + #:user "nobody" + #:group "nogroup" + #:log-file #$log-file + #:environment-variables + (list (format #f "TUNNEL_TOKEN=~a" #$token)))) + (stop #~(make-kill-destructor)))))) (define cloudflare-tunnel-service-type (service-type @@ -202,14 +194,15 @@ headers. This can expose sensitive information in your logs.") ;; -(define-configuration/no-serialization cloudflare-warp-configuration +(define-configuration cloudflare-warp-configuration (cloudflare-warp (file-like cloudflare-warp-bin) - "The Cloudflare Warp package.")) + "The Cloudflare Warp package.") + (no-serialization)) -(define (cloudflare-warp-shepherd-service config) - (match-record config - (cloudflare-warp) +(define cloudflare-warp-shepherd-service + (match-record-lambda + (cloudflare-warp) (list (shepherd-service (documentation "Run warp-svc.") (provision '(cloudflare-warp)) @@ -234,16 +227,18 @@ headers. This can expose sensitive information in your logs.") ;; Miniflux ;; -(define-configuration/no-serialization miniflux-configuration + +(define-configuration miniflux-configuration (miniflux - (package miniflux) + (file-like miniflux) "The miniflux package.") (log-file (string "/var/log/miniflux.log") "Where the logs go.") (options (alist '()) - "Association list of miniflux configuration options.")) + "Association list of miniflux configuration options.") + (no-serialization)) (define %miniflux-accounts (list (user-account @@ -258,9 +253,9 @@ headers. This can expose sensitive information in your logs.") (name "miniflux") (create-database? #t)))) -(define (miniflux-shepherd-service config) - (match-record config - (miniflux log-file options) +(define miniflux-shepherd-service + (match-record-lambda + (miniflux log-file options) (let ((config-file (mixed-text-file "miniflux.conf" (apply string-append @@ -298,27 +293,28 @@ headers. This can expose sensitive information in your logs.") ;; -(define-configuration/no-serialization home-wakapi-configuration +(define-configuration home-wakapi-configuration (wakapi (file-like wakapi-bin) "The wakapi package.") (config (yaml-config '()) - "Association list of Wakapi configurations.")) + "Association list of Wakapi configurations.") + (no-serialization)) (define home-wakapi-shepherd-service - (match-lambda - (($ wakapi config) - (let ((config-file (mixed-text-file - "wakapi.yaml" - #~(string-append #$@(serialize-yaml-config config) "\n")))) - (list (shepherd-service - (documentation "Run wakapi.") - (provision '(wakapi)) - (start #~(make-forkexec-constructor - (list #$(file-append wakapi "/bin/wakapi") - "-config" #$config-file))) - (stop #~(make-kill-destructor)))))))) + (match-record-lambda + (wakapi config) + (let ((config-file (mixed-text-file + "wakapi.yaml" + #~(string-append #$@(serialize-yaml-config config) "\n")))) + (list (shepherd-service + (documentation "Run wakapi.") + (provision '(wakapi)) + (start #~(make-forkexec-constructor + (list #$(file-append wakapi "/bin/wakapi") + "-config" #$config-file))) + (stop #~(make-kill-destructor))))))) (define home-wakapi-service-type (service-type @@ -347,9 +343,9 @@ headers. This can expose sensitive information in your logs.") "HTTP proxy address to serve.") (no-serialization)) -(define (home-socks2http-shepherd-service config) - (match-record config - (socks2http socks-address http-address) +(define home-socks2http-shepherd-service + (match-record-lambda + (socks2http socks-address http-address) (list (shepherd-service (documentation "Run socks2http.") (provision '(socks2http)) diff --git a/rosenthal/services/dns.scm b/rosenthal/services/dns.scm index 055b55a..96fe188 100644 --- a/rosenthal/services/dns.scm +++ b/rosenthal/services/dns.scm @@ -4,7 +4,6 @@ (define-module (rosenthal services dns) #:use-module (guix gexp) - #:use-module (guix packages) #:use-module (guix records) #:use-module (gnu services) #:use-module (gnu services configuration) @@ -17,17 +16,19 @@ ;; Smartdns ;; -(define-configuration/no-serialization smartdns-configuration + +(define-configuration smartdns-configuration (smartdns - (package smartdns) + (file-like smartdns) "The Smartdns package.") (config-file (file-like (plain-file "empty" "")) - "Configuration file for Smartdns.")) + "Configuration file for Smartdns.") + (no-serialization)) -(define (smartdns-shepherd-service config) - (match-record config - (smartdns config-file) +(define smartdns-shepherd-service + (match-record-lambda + (smartdns config-file) (list (shepherd-service (documentation "Run smartdns.") (provision '(smartdns dns)) diff --git a/rosenthal/services/networking.scm b/rosenthal/services/networking.scm index 221c261..097215b 100644 --- a/rosenthal/services/networking.scm +++ b/rosenthal/services/networking.scm @@ -3,10 +3,9 @@ ;; SPDX-License-Identifier: BSD-3-Clause (define-module (rosenthal services networking) - #:use-module (ice-9 match) + #:use-module ((guix import utils) #:select (flatten)) #:use-module (guix gexp) - #:use-module (guix import utils) - #:use-module (guix packages) + #:use-module (guix records) #:use-module (gnu packages dns) #:use-module (gnu packages base) #:use-module (gnu packages networking) @@ -15,10 +14,7 @@ #:use-module (gnu services base) #:use-module (gnu services shepherd) #:use-module (gnu services configuration) - #:use-module ((rosenthal utils home-services-utils) - #:select (ini-config? - maybe-object->string - generic-serialize-ini-config)) + #:use-module (rosenthal utils home-services-utils) #:export (iwd-service-type iwd-configuration)) @@ -40,39 +36,41 @@ #:serialize-field serialize-field #:fields config)) -(define-configuration/no-serialization iwd-configuration +(define-configuration iwd-configuration (iwd - (package iwd) + (file-like iwd) "The iwd package.") (config (ini-config '()) - "Association list of iwd configurations.")) + "Association list of iwd configurations.") + (no-serialization)) (define iwd-shepherd-service - (match-lambda - (($ iwd _) - (let ((environment #~(list (string-append - "PATH=" - (string-append #$openresolv "/sbin") - ":" - (string-append #$coreutils "/bin"))))) - (list (shepherd-service - (documentation "Run iwd") - (provision '(iwd networking)) - (requirement '(user-processes dbus-system loopback)) - (start #~(make-forkexec-constructor - (list (string-append #$iwd "/libexec/iwd")) - #:log-file "/var/log/iwd.log" - #:environment-variables #$environment)) - (stop #~(make-kill-destructor)))))))) + (match-record-lambda + (iwd config) + (let ((environment + #~(list (string-append + "PATH=" (string-join + (list (file-append openresolv "/sbin") + (file-append coreutils "/bin")) + ":"))))) + (list (shepherd-service + (documentation "Run iwd") + (provision '(iwd networking)) + (requirement '(user-processes dbus-system loopback)) + (start #~(make-forkexec-constructor + (list (string-append #$iwd "/libexec/iwd")) + #:log-file "/var/log/iwd.log" + #:environment-variables #$environment)) + (stop #~(make-kill-destructor))))))) (define iwd-etc-service - (match-lambda - (($ _ config) - `(("iwd/main.conf" - ,(apply mixed-text-file - "main.conf" - (serialize-ini-config config))))))) + (match-record-lambda + (iwd config) + `(("iwd/main.conf" + ,(apply mixed-text-file + "main.conf" + (serialize-ini-config config)))))) (define add-iwd-package (compose list iwd-configuration-iwd))