;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2018 Mathieu Othacehe ;;; ;;; This file is part of GNU Guix. ;;; ;;; GNU Guix is free software; you can redistribute it and/or modify it ;;; under the terms of the GNU General Public License as published by ;;; the Free Software Foundation; either version 3 of the License, or (at ;;; your option) any later version. ;;; ;;; GNU Guix is distributed in the hope that it will be useful, but ;;; WITHOUT ANY WARRANTY; without even the implied warranty of ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;;; GNU General Public License for more details. ;;; ;;; You should have received a copy of the GNU General Public License ;;; along with GNU Guix. If not, see . (define-module (gnu installer timezone) #:use-module (gnu installer utils) #:use-module (guix i18n) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) #:use-module (ice-9 match) #:use-module (ice-9 receive) #:export (locate-children timezone->posix-tz timezone-has-child? zonetab->timezone-tree posix-tz->configuration)) (define %not-blank (char-set-complement char-set:blank)) (define (posix-tz->timezone tz) "Convert given TZ in Posix format like \"Europe/Paris\" into a list like (\"Europe\" \"Paris\")." (string-split tz #\/)) (define (timezone->posix-tz timezone) "Convert given TIMEZONE like (\"Europe\" \"Paris\") into a Posix timezone like \"Europe/Paris\"." (string-join timezone "/")) (define (zonetab->timezones zonetab) "Parse ZONETAB file and return the corresponding list of timezones." (define (zonetab-line->posix-tz line) (let ((tokens (string-tokenize line %not-blank))) (match tokens ((code coordinates tz _ ...) tz)))) (call-with-input-file zonetab (lambda (port) (let* ((lines (read-lines port)) ;; Filter comment lines starting with '#' character. (tz-lines (filter (lambda (line) (not (eq? (string-ref line 0) #\#))) lines))) (map (lambda (line) (posix-tz->timezone (zonetab-line->posix-tz line))) tz-lines))))) (define (timezones->timezone-tree timezones) "Convert the list of timezones, TIMEZONES into a tree under the form: (\"America\" (\"North_Dakota\" \"New_Salem\" \"Center\")) representing America/North_Dakota/New_Salem and America/North_Dakota/Center timezones." (define (remove-first lists) "Remove the first element of every sublists in the argument LISTS." (map (lambda (list) (if (null? list) list (cdr list))) lists)) (let loop ((cur-timezones timezones)) (match cur-timezones (() '()) (((region . rest-region) . rest-timezones) (if (null? rest-region) (cons (list region) (loop rest-timezones)) (receive (same-region other-region) (partition (lambda (timezone) (string=? (car timezone) region)) cur-timezones) (acons region (loop (remove-first same-region)) (loop other-region)))))))) (define (locate-children tree path) "Return the children of the timezone indicated by PATH in the given TREE. Raise a condition if the PATH could not be found." (let ((extract-proc (cut map car <>))) (match path (() (sort (extract-proc tree) string (assoc-ref tree region) (cut locate-children <> rest)) (raise (condition (&message (message (format #f (G_ "Unable to locate path: ~a.") path)))))))))) (define (timezone-has-child? tree timezone) "Return #t if the given TIMEZONE any child in TREE and #f otherwise." (not (null? (locate-children tree timezone)))) (define* (zonetab->timezone-tree zonetab) "Return the timezone tree corresponding to the given ZONETAB file." (timezones->timezone-tree (zonetab->timezones zonetab))) ;;; ;;; Configuration formatter. ;;; (define (posix-tz->configuration timezone) "Return the configuration field for TIMEZONE." `((timezone ,timezone))) ail.scm (dovecot-service-type)[description]: New field. (opensmtpd-service-type)[description]: New field. (mail-aliases-service-type)[description]: New field. (exim-service-type)[description]: New field. * gnu/services/monitoring.scm (zabbix-server-service-type)[description]: New field. (zabbix-agent-service-type)[description]: New field. * gnu/services/nfs.scm (rpcbind-service-type)[description]: New field. (pipefs-service-type)[description]: New field. (gss-service-type)[description]: New field. (idmap-service-type)[description]: New field. * gnu/services/spice.scm (spice-vdagent-service-type)[description]: New field. * gnu/services/sysctl.scm (sysctl-service-type)[description]: New field. * gnu/services/virtualization.scm (libvirt-service-type)[description]: New field. (virtlog-service-type)[description]: New field. * gnu/services/vpn.scm (openvpn-server-service-type)[description]: New field. (openvpn-client-service-type)[description]: New field. (wireguard-service-type)[description]: New field. * gnu/services/web.scm (httpd-service-type)[description]: New field. (fcgiwrap-service-type)[description]: New field. (agate-service-type)[description]: New field. [name]: Fix. Ludovic Courtès 2022-03-17Revert "services: nfs: Define rpcbind-shepherd-service at the top level."...This reverts commit 0a9e82b43080275a2755624f3208287056dc9f95, which didn't end up fixing anything. The problem was elsewhere; namely, using 'operating-system-services' instead of 'operating-system-user-services'. Maxim Cournoyer 2022-03-17services: nfs: Define rpcbind-shepherd-service at the top level....Attempting to use the 'nfs-service-type' as part of a computed operating-system definition, the following exception would be thrown: ice-9/boot-9.scm:1685:16: In procedure raise-exception: ERROR: 1. &ambiguous-target-service-error: service: #<<service> type: #<service-type rpcbind 7f7529853780> value: #<<rpcbind-configuration> rpcbind: #<package rpcbind@1.2.6 gnu/packages/onc-rpc.scm:87 7f75389e78f0> warm-start?: #t>> target-type: #<service-type shepherd-root 7f7529396080> 2. &message: "more than one target service of type 'shepherd-root'" The problem was that the rpcbind shepherd-service object was dynamically instantiated every time the rpcbind-service-type would be called, causing multiple objects in some situations, resulting in the above condition. * gnu/services/nfs.scm (rpcbind-service-type): Refactor and adjust in a way to extract... (rpcbind-shepherd-service): ... this new procedure. Maxim Cournoyer