diff options
Diffstat (limited to 'gnu/home')
| -rw-r--r-- | gnu/home/services/fontutils.scm | 38 | ||||
| -rw-r--r-- | gnu/home/services/shepherd.scm | 2 | ||||
| -rw-r--r-- | gnu/home/services/ssh.scm | 22 |
3 files changed, 43 insertions, 19 deletions
diff --git a/gnu/home/services/fontutils.scm b/gnu/home/services/fontutils.scm index 3399cb7ec8..0e60bc2035 100644 --- a/gnu/home/services/fontutils.scm +++ b/gnu/home/services/fontutils.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2021 Andrew Tropin <andrew@trop.in> ;;; Copyright © 2021 Xinglu Chen <public@yoctocell.xyz> ;;; Copyright © 2023 Giacomo Leidi <goodoldpaul@autistici.org> +;;; Copyright © 2023 Andrew Patterson <andrewpatt7@gmail.com> ;;; ;;; This file is part of GNU Guix. ;;; @@ -23,6 +24,8 @@ #:use-module (gnu packages fontutils) #:use-module (guix gexp) #:use-module (srfi srfi-1) + #:use-module (ice-9 match) + #:use-module (sxml simple) #:export (home-fontconfig-service-type)) @@ -35,17 +38,36 @@ ;;; ;;; Code: -(define (add-fontconfig-config-file directories) +(define (write-fontconfig-doctype) + "Prints fontconfig's DOCTYPE to current-output-port." + ;; This is necessary because SXML doesn't seem to have a way to represent a doctype, + ;; but sxml->xml /does/ currently call any thunks in the SXML with the XML output port + ;; as current-output-port, allowing the output to include arbitrary text instead of + ;; just properly quoted XML. + (format #t "<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'>")) + +(define (config->sxml config) + "Converts a <home-fontconfig-configuration> record into the SXML representation +of fontconfig's fonts.conf file." + (define (snippets->sxml snippet) + (match snippet + ((or (? string? dir) + (? gexp? dir)) + `(dir ,dir)) + ((? list?) + snippet))) + `(*TOP* (*PI* xml "version='1.0'") + ,write-fontconfig-doctype + (fontconfig + ,@(map snippets->sxml config)))) + +(define (add-fontconfig-config-file config) `(("fontconfig/fonts.conf" ,(mixed-text-file "fonts.conf" - (apply string-append - `("<?xml version='1.0'?> -<!DOCTYPE fontconfig SYSTEM 'fonts.dtd'> -<fontconfig>\n" ,@(map (lambda (directory) - (string-append " <dir>" directory "</dir>\n")) - directories) - "</fontconfig>\n")))))) + (call-with-output-string + (lambda (port) + (sxml->xml (config->sxml config) port))))))) (define (regenerate-font-cache-gexp _) `(("profile/share/fonts" diff --git a/gnu/home/services/shepherd.scm b/gnu/home/services/shepherd.scm index 1a70a220f0..ff6d629114 100644 --- a/gnu/home/services/shepherd.scm +++ b/gnu/home/services/shepherd.scm @@ -52,7 +52,7 @@ home-shepherd-configuration make-home-shepherd-configuration home-shepherd-configuration? (shepherd home-shepherd-configuration-shepherd - (default shepherd-0.9)) ; package + (default shepherd-0.10)) ; package (auto-start? home-shepherd-configuration-auto-start? (default #t)) (daemonize? home-shepherd-configuration-daemonize? diff --git a/gnu/home/services/ssh.scm b/gnu/home/services/ssh.scm index 6aeb6ad5a7..628dc743ae 100644 --- a/gnu/home/services/ssh.scm +++ b/gnu/home/services/ssh.scm @@ -249,7 +249,7 @@ through before connecting to the server.") home-openssh-configuration make-home-openssh-configuration home-openssh-configuration? (authorized-keys home-openssh-configuration-authorized-keys ;list of file-like - (default '())) + (default #f)) (known-hosts home-openssh-configuration-known-hosts ;unspec | list of file-like (default *unspecified*)) (hosts home-openssh-configuration-hosts ;list of <openssh-host> @@ -285,19 +285,21 @@ inserted after each of them." '#$files))))))) (define (openssh-configuration-files config) - (let ((config (plain-file "ssh.conf" - (openssh-configuration->string config))) - (known-hosts (home-openssh-configuration-known-hosts config)) - (authorized-keys (file-join - "authorized_keys" - (home-openssh-configuration-authorized-keys config) - "\n"))) - `((".ssh/authorized_keys" ,authorized-keys) + (let* ((ssh-config (plain-file "ssh.conf" + (openssh-configuration->string config))) + (known-hosts (home-openssh-configuration-known-hosts config)) + (authorized-keys (home-openssh-configuration-authorized-keys config)) + (authorized-keys (and + authorized-keys + (file-join "authorized_keys" authorized-keys "\n")))) + `(,@(if authorized-keys + `((".ssh/authorized_keys" ,authorized-keys)) + '()) ,@(if (unspecified? known-hosts) '() `((".ssh/known_hosts" ,(file-join "known_hosts" known-hosts "\n")))) - (".ssh/config" ,config)))) + (".ssh/config" ,ssh-config)))) (define openssh-activation (with-imported-modules (source-module-closure |