aboutsummaryrefslogtreecommitdiff
path: root/gnu/installer/timezone.scm
blob: c336b5f3ba41218ab686f8f2a87b7766c13c11bd (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2018 Mathieu Othacehe <m.othacehe@gmail.com>
;;;
;;; 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 <http://www.gnu.org/licenses/>.

(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<?))
      ((region . rest)
       (or (and=> (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)))
.scm?id=8b223ceac4ff0781e95d69362875f87cff03f4d6'>services: nginx: Replace 'http-port' and 'https-port' with 'listen'.Clément Lassieur * doc/guix.texi (Web Services, Version Control Services): Update accordingly. * gnu/services/certbot.scm (certbot-nginx-server-configurations): Likewise. * gnu/services/version-control.scm (%cgit-configuration-nginx): Likewise. * gnu/services/web.scm (<nginx-server-configuration>, emit-nginx-server-config): Likewise. * gnu/tests/version-control.scm (%cgit-configuration-nginx, %git-nginx-configuration): Likewise. * gnu/tests/web.scm (%nginx-servers, %php-fpm-nginx-server-blocks): Likewise. 2017-12-12gnu: services: Add php-fpm.nee * gnu/services/web.scm (<php-fpm-configuration>, <php-fpm-process-manager-configuration>): New record types. (php-fpm-configuration?, php-fpm-process-manager-configuration?, php-fpm-service-type, nginx-php-location): New procedures. * doc/guix.texi (Web-Services): Document php-fpm service. * gnu/tests/web.scm: Add php-fpm system test. Signed-off-by: Christopher Baines <mail@cbaines.net> 2017-12-11services: web: Remove default certificate and key files for nginx.Christopher Baines If nginx is configured with a ssl-certificate file, and ssl-certificate-key, it will fail to start unless these exist. To avoid this happening, change the default to #f. * gnu/services/web.scm (<nginx-server-configuration>) [ssl-certificate,ssl-certificate-key]: Set the defaults to #f. * gnu/tests/web.scm (%nginx-servers): Remove redundant nginx-server-configuration fields. * doc/guix.texi (Web Services): Update examples and documentation. 2017-07-20tests: Use 'virtual-machine' records instead of monadic procedures.Ludovic Courtès * gnu/tests/base.scm (%test-basic-os): Use 'let*' instead of 'mlet*' and 'virtual-machine' instead of 'system-qemu-image/shared-store-script'. (run-mcron-test): Likewise. (run-nss-mdns-test): Likewise. * gnu/tests/dict.scm (run-dicod-test): Likewise. * gnu/tests/mail.scm (run-opensmtpd-test): Likewise. (run-exim-test): Likewise. * gnu/tests/messaging.scm (run-xmpp-test): Likewise. * gnu/tests/networking.scm (run-inetd-test): Likewise. * gnu/tests/nfs.scm (run-nfs-test): Likewise. * gnu/tests/ssh.scm (run-ssh-test): Likewise. * gnu/tests/web.scm (run-nginx-test): Likewise. 2017-04-15tests: Remove unused import (gnu system grub).Danny Milosavljevic * gnu/tests/web.scm: Remove unused import. 2017-04-01tests: Introduce 'simple-operating-system' and use it.Ludovic Courtès * gnu/tests.scm (%simple-os): New macro. (simple-operating-system): New macro. * gnu/tests/base.scm (%simple-os): Define using 'simple-operating-system'. (%mcron-os): Use 'simple-operating-system'. * gnu/tests/mail.scm (%opensmtpd-os): Likewise. * gnu/tests/messaging.scm (%base-os, os-with-service): Remove. (run-xmpp-test): Use 'simple-operating-system'. * gnu/tests/networking.scm (%inetd-os): Likewise. * gnu/tests/ssh.scm (%base-os, os-with-service): Remove. (run-ssh-test): Use 'simple-operating-system'. * gnu/tests/web.scm (%nginx-os): Likewise. 2017-01-19tests: Add 'nginx-service-type' test.Ludovic Courtès * gnu/tests/web.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.