guix-devel
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[PATCH] services: Fix 'mkdir-p' in activation scripts.


From: Clément Lassieur
Subject: [PATCH] services: Fix 'mkdir-p' in activation scripts.
Date: Tue, 24 Jan 2017 01:24:19 +0100

* gnu/services/cuirass.scm (cuirass-activation): Import (guix build utils) and
  remove (with-imported-modules '((guix build utils))).
* gnu/services/cups.scm (%cups-activation): Idem.
* gnu/services/networking.scm (ntp-service-activation): Idem.

* gnu/services/mail.scm (opensmtpd-activation): Import (guix build utils).
* gnu/services/spice.scm (spice-vdagent-activation): Idem.
* gnu/services/ssh.scm (openssh-activation): Idem.
  (dropbear-activation): Idem.
* gnu/services/vpn.scm (%openvpn-activation): Idem.
---
 gnu/services/cuirass.scm    |  19 ++++---
 gnu/services/cups.scm       | 121 ++++++++++++++++++++++----------------------
 gnu/services/mail.scm       |   2 +
 gnu/services/networking.scm |  15 +++---
 gnu/services/spice.scm      |   5 +-
 gnu/services/ssh.scm        |   3 ++
 gnu/services/vpn.scm        |   5 +-
 7 files changed, 91 insertions(+), 79 deletions(-)

diff --git a/gnu/services/cuirass.scm b/gnu/services/cuirass.scm
index 1194133f6..64eb97bbf 100644
--- a/gnu/services/cuirass.scm
+++ b/gnu/services/cuirass.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2016 Mathieu Lirzin <address@hidden>
 ;;; Copyright © 2016, 2017 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2017 Mathieu Othacehe <address@hidden>
+;;; Copyright © 2017 Clément Lassieur <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -121,17 +122,15 @@
         (db    (dirname (cuirass-configuration-database config)))
         (user  (cuirass-configuration-user config))
         (group (cuirass-configuration-group config)))
-    (with-imported-modules '((guix build utils))
-      #~(begin
-          (use-modules (guix build utils))
+    #~(begin
+        (use-modules (guix build utils))
+        (mkdir-p #$cache)
+        (mkdir-p #$db)
 
-          (mkdir-p #$cache)
-          (mkdir-p #$db)
-
-          (let ((uid (passwd:uid (getpw #$user)))
-                (gid (group:gid (getgr #$group))))
-            (chown #$cache uid gid)
-            (chown #$db uid gid))))))
+        (let ((uid (passwd:uid (getpw #$user)))
+              (gid (group:gid (getgr #$group))))
+          (chown #$cache uid gid)
+          (chown #$db uid gid)))))
 
 (define cuirass-service-type
   (service-type
diff --git a/gnu/services/cups.scm b/gnu/services/cups.scm
index df1843e43..3bccb9da4 100644
--- a/gnu/services/cups.scm
+++ b/gnu/services/cups.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Andy Wingo <address@hidden>
+;;; Copyright © 2017 Clément Lassieur <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -809,66 +810,66 @@ IPP specifications.")
 
 (define %cups-activation
   ;; Activation gexp.
-  (with-imported-modules '((guix build utils))
-    #~(begin
-        (define (mkdir-p/perms directory owner perms)
-          (mkdir-p directory)
-          (chown "/var/run/cups" (passwd:uid owner) (passwd:gid owner))
-          (chmod directory perms))
-        (define (build-subject parameters)
-          (string-concatenate
-           (map (lambda (pair)
-                  (let ((k (car pair)) (v (cdr pair)))
-                    (define (escape-char str chr)
-                      (string-join (string-split str chr) (string #\\ chr)))
-                    (string-append "/" k "="
-                                   (escape-char (escape-char v #\=) #\/))))
-                (filter (lambda (pair) (cdr pair)) parameters))))
-        (define* (create-self-signed-certificate-if-absent
-                  #:key private-key public-key (owner (getpwnam "root"))
-                  (common-name (gethostname))
-                  (organization-name "GuixSD")
-                  (organization-unit-name "Default Self-Signed Certificate")
-                  (subject-parameters `(("CN" . ,common-name)
-                                        ("O" . ,organization-name)
-                                        ("OU" . ,organization-unit-name)))
-                  (subject (build-subject subject-parameters)))
-          ;; Note that by default, OpenSSL outputs keys in PEM format.  This
-          ;; is what we want.
-          (unless (file-exists? private-key)
-            (cond
-             ((zero? (system* (string-append #$openssl "/bin/openssl")
-                              "genrsa" "-out" private-key "2048"))
-              (chown private-key (passwd:uid owner) (passwd:gid owner))
-              (chmod private-key #o400))
-             (else
-              (format (current-error-port)
-                      "Failed to create private key at ~a.\n" private-key))))
-          (unless (file-exists? public-key)
-            (cond
-             ((zero? (system* (string-append #$openssl "/bin/openssl")
-                              "req" "-new" "-x509" "-key" private-key
-                              "-out" public-key "-days" "3650"
-                              "-batch" "-subj" subject))
-              (chown public-key (passwd:uid owner) (passwd:gid owner))
-              (chmod public-key #o444))
-             (else
-              (format (current-error-port)
-                      "Failed to create public key at ~a.\n" public-key)))))
-        (let ((user (getpwnam "lp")))
-          (mkdir-p/perms "/var/run/cups" user #o755)
-          (mkdir-p/perms "/var/spool/cups" user #o755)
-          (mkdir-p/perms "/var/spool/cups/tmp" user #o755)
-          (mkdir-p/perms "/var/log/cups" user #o755)
-          (mkdir-p/perms "/etc/cups" user #o755)
-          (mkdir-p/perms "/etc/cups/ssl" user #o700)
-          ;; This certificate is used for HTTPS connections to the CUPS web
-          ;; interface.
-          (create-self-signed-certificate-if-absent
-           #:private-key "/etc/cups/ssl/localhost.key"
-           #:public-key "/etc/cups/ssl/localhost.crt"
-           #:owner (getpwnam "root")
-           #:common-name (format #f "CUPS service on ~a" (gethostname)))))))
+  #~(begin
+      (use-modules (guix build utils))
+      (define (mkdir-p/perms directory owner perms)
+        (mkdir-p directory)
+        (chown "/var/run/cups" (passwd:uid owner) (passwd:gid owner))
+        (chmod directory perms))
+      (define (build-subject parameters)
+        (string-concatenate
+         (map (lambda (pair)
+                (let ((k (car pair)) (v (cdr pair)))
+                  (define (escape-char str chr)
+                    (string-join (string-split str chr) (string #\\ chr)))
+                  (string-append "/" k "="
+                                 (escape-char (escape-char v #\=) #\/))))
+              (filter (lambda (pair) (cdr pair)) parameters))))
+      (define* (create-self-signed-certificate-if-absent
+                #:key private-key public-key (owner (getpwnam "root"))
+                (common-name (gethostname))
+                (organization-name "GuixSD")
+                (organization-unit-name "Default Self-Signed Certificate")
+                (subject-parameters `(("CN" . ,common-name)
+                                      ("O" . ,organization-name)
+                                      ("OU" . ,organization-unit-name)))
+                (subject (build-subject subject-parameters)))
+        ;; Note that by default, OpenSSL outputs keys in PEM format.  This
+        ;; is what we want.
+        (unless (file-exists? private-key)
+          (cond
+           ((zero? (system* (string-append #$openssl "/bin/openssl")
+                            "genrsa" "-out" private-key "2048"))
+            (chown private-key (passwd:uid owner) (passwd:gid owner))
+            (chmod private-key #o400))
+           (else
+            (format (current-error-port)
+                    "Failed to create private key at ~a.\n" private-key))))
+        (unless (file-exists? public-key)
+          (cond
+           ((zero? (system* (string-append #$openssl "/bin/openssl")
+                            "req" "-new" "-x509" "-key" private-key
+                            "-out" public-key "-days" "3650"
+                            "-batch" "-subj" subject))
+            (chown public-key (passwd:uid owner) (passwd:gid owner))
+            (chmod public-key #o444))
+           (else
+            (format (current-error-port)
+                    "Failed to create public key at ~a.\n" public-key)))))
+      (let ((user (getpwnam "lp")))
+        (mkdir-p/perms "/var/run/cups" user #o755)
+        (mkdir-p/perms "/var/spool/cups" user #o755)
+        (mkdir-p/perms "/var/spool/cups/tmp" user #o755)
+        (mkdir-p/perms "/var/log/cups" user #o755)
+        (mkdir-p/perms "/etc/cups" user #o755)
+        (mkdir-p/perms "/etc/cups/ssl" user #o700)
+        ;; This certificate is used for HTTPS connections to the CUPS web
+        ;; interface.
+        (create-self-signed-certificate-if-absent
+         #:private-key "/etc/cups/ssl/localhost.key"
+         #:public-key "/etc/cups/ssl/localhost.crt"
+         #:owner (getpwnam "root")
+         #:common-name (format #f "CUPS service on ~a" (gethostname))))))
 
 (define (union-directory name packages paths)
   (computed-file
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index c1381405d..30b1672d3 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2015 Andy Wingo <address@hidden>
+;;; Copyright © 2017 Clément Lassieur <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -1601,6 +1602,7 @@ accept from local for any relay
     (($ <opensmtpd-configuration> package config-file)
      (let ((smtpd (file-append package "/sbin/smtpd")))
        #~(begin
+           (use-modules (guix build utils))
            ;; Create mbox and spool directories.
            (mkdir-p "/var/mail")
            (mkdir-p "/var/spool/smtpd")
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 8f136f0dc..e86d90e80 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -3,6 +3,7 @@
 ;;; Copyright © 2015 Mark H Weaver <address@hidden>
 ;;; Copyright © 2016 Efraim Flashner <address@hidden>
 ;;; Copyright © 2016 John Darrington <address@hidden>
+;;; Copyright © 2017 Clément Lassieur <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -330,14 +331,14 @@ restrict -6 ::1\n"))
 
 (define (ntp-service-activation config)
   "Return the activation gexp for CONFIG."
-  (with-imported-modules '((guix build utils))
-    #~(begin
-        (define %user
-          (getpw "ntpd"))
+  #~(begin
+      (use-modules (guix build utils))
+      (define %user
+        (getpw "ntpd"))
 
-        (let ((directory "/var/run/ntpd"))
-          (mkdir-p directory)
-          (chown directory (passwd:uid %user) (passwd:gid %user))))))
+      (let ((directory "/var/run/ntpd"))
+        (mkdir-p directory)
+        (chown directory (passwd:uid %user) (passwd:gid %user)))))
 
 (define ntp-service-type
   (service-type (name 'ntp)
diff --git a/gnu/services/spice.scm b/gnu/services/spice.scm
index bd0a53834..2f9dfd57a 100644
--- a/gnu/services/spice.scm
+++ b/gnu/services/spice.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 David Craven <address@hidden>
+;;; Copyright © 2017 Clément Lassieur <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -35,7 +36,9 @@
 
 (define (spice-vdagent-activation config)
   "Return the activation gexp for CONFIG."
-  #~(mkdir-p "/var/run/spice-vdagentd"))
+  #~(begin
+      (use-modules (guix build utils))
+      (mkdir-p "/var/run/spice-vdagentd")))
 
 (define (spice-vdagent-shepherd-service config)
   "Return a <shepherd-service> for spice-vdagentd with CONFIG."
diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm
index 6da612da6..58c35c9f5 100644
--- a/gnu/services/ssh.scm
+++ b/gnu/services/ssh.scm
@@ -2,6 +2,7 @@
 ;;; Copyright © 2014, 2015, 2016 Ludovic Courtès <address@hidden>
 ;;; Copyright © 2016 David Craven <address@hidden>
 ;;; Copyright © 2016 Julien Lepiller <address@hidden>
+;;; Copyright © 2017 Clément Lassieur <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -292,6 +293,7 @@ The other options should be self-descriptive."
 (define (openssh-activation config)
   "Return the activation GEXP for CONFIG."
   #~(begin
+      (use-modules (guix build utils))
       (mkdir-p "/etc/ssh")
       (mkdir-p (dirname #$(openssh-configuration-pid-file config)))
 
@@ -388,6 +390,7 @@ The other options should be self-descriptive."
 (define (dropbear-activation config)
   "Return the activation gexp for CONFIG."
   #~(begin
+      (use-modules (guix build utils))
       (mkdir-p "/etc/dropbear")))
 
 (define (dropbear-shepherd-service config)
diff --git a/gnu/services/vpn.scm b/gnu/services/vpn.scm
index f577e0851..844a11b3d 100644
--- a/gnu/services/vpn.scm
+++ b/gnu/services/vpn.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2017 Julien Lepiller <address@hidden>
+;;; Copyright © 2017 Clément Lassieur <address@hidden>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -444,7 +445,9 @@ is trunkated and rewritten every minute.")
          (shell (file-append shadow "/sbin/nologin")))))
 
 (define %openvpn-activation
-  #~(mkdir-p "/var/run/openvpn"))
+  #~(begin
+      (use-modules (guix build utils))
+      (mkdir-p "/var/run/openvpn")))
 
 (define openvpn-server-service-type
   (service-type (name 'openvpn-server)
-- 
2.11.0




reply via email to

[Prev in Thread] Current Thread [Next in Thread]