02/02: hydra: Add sysadmin support modules.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository maintenance.

commit 66a0593dd09be6b5323d61b84e555d6312499b76
Author: Ludovic Courtès <address@hidden>
Date:   Fri Aug 19 09:08:52 2016 +0200

    hydra: Add sysadmin support modules.
---
 hydra/build-machine.scm                   |   27 ++++++++
 hydra/modules/sysadmin/build-machines.scm |   68 +++++++++++++++++++
 hydra/modules/sysadmin/people.scm         |  102 +++++++++++++++++++++++++++++
 3 files changed, 197 insertions(+)

diff --git a/hydra/build-machine.scm b/hydra/build-machine.scm
new file mode 100644
index 0000000..067206a
--- /dev/null
+++ b/hydra/build-machine.scm
@@ -0,0 +1,27 @@
+;; GuixSD configuration file for the build machines.
+;; Copyright © 2016 Ludovic Courtès <address@hidden>
+;; Released under the GNU GPLv3 or any later version.
+
+(use-modules (sysadmin people)
+             (sysadmin build-machines)
+             (guix))
+
+(define %sysadmins
+  ;; The fine folks!
+  (list (sysadmin (name "ludo")
+                  (full-name "Ludovic Courtès")
+                  (lsh-public-key
+                   (local-file "/home/ludo/.lsh/identity.pub")))
+        (sysadmin (name "hydra")                  ;fake sysadmin
+                  (full-name "Hydra User")
+                  (restricted? #t)
+                  (lsh-public-key
+                   (local-file "/home/ludo/.lsh/identity.pub")))))
+
+(define %authorized-guix-keys
+  ;; List of authorized 'guix archive' keys.
+  (list (local-file "/etc/guix/signing-key.pub")))
+
+;; The actual machine.
+(build-machine-os "chapters" %sysadmins
+                  #:authorized-guix-keys %authorized-guix-keys)
diff --git a/hydra/modules/sysadmin/build-machines.scm 
b/hydra/modules/sysadmin/build-machines.scm
new file mode 100644
index 0000000..ab90e81
--- /dev/null
+++ b/hydra/modules/sysadmin/build-machines.scm
@@ -0,0 +1,68 @@
+;;; GNU Guix system administration tools.
+;;;
+;;; Copyright © 2016 Ludovic Courtès <address@hidden>
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (sysadmin build-machines)
+  #:use-module (gnu)
+  #:use-module (gnu services base)
+  #:use-module (gnu services ssh)
+  #:use-module (gnu services mcron)
+  #:use-module (gnu services networking)
+  #:use-module (guix gexp)
+  #:use-module (sysadmin people)
+  #:export (build-machine-os))
+
+;;; Commentary:
+;;;
+;;; Configuration of build machines.
+;;;
+;;; Code:
+
+(define* (build-machine-os host-name sysadmins
+                           #:key (authorized-guix-keys '()))
+  "Return the <operating-system> declaration for a build machine called
+HOST-NAME and accessibly by SYSADMINS, with the given AUTHORIZED-GUIX-KEYS."
+  (define gc-job
+    ;; Run 'guix gc' at 3AM every day.
+    #~(job '(next-hour '(3))
+           "guix gc -F 40G"))
+
+  (operating-system
+    (host-name host-name)
+    (timezone "Europe/Paris")
+    (locale "en_US.UTF-8")
+
+    (bootloader (grub-configuration (device "/dev/sdX")))
+    (file-systems (cons (file-system
+                          (device "my-root")
+                          (title 'label)
+                          (mount-point "/")
+                          (type "ext4"))
+                        %base-file-systems))
+
+    (services (cons* (service sysadmin-service-type sysadmins)
+                     (lsh-service)
+                     (dhcp-client-service)
+                     (mcron-service (list gc-job))
+                     (modify-services %base-services
+                       (guix-service-type config =>
+                                          (guix-configuration
+                                           (inherit config)
+                                           (use-substitutes? #f)
+                                           (authorized-keys
+                                            authorized-guix-keys))))))))
+
+;;; build-machines.scm end here
diff --git a/hydra/modules/sysadmin/people.scm 
b/hydra/modules/sysadmin/people.scm
new file mode 100644
index 0000000..0d9cca7
--- /dev/null
+++ b/hydra/modules/sysadmin/people.scm
@@ -0,0 +1,102 @@
+;;; GNU Guix system administration tools.
+;;;
+;;; Copyright © 2016 Ludovic Courtès <address@hidden>
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (sysadmin people)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:use-module (gnu services)
+  #:use-module (gnu system shadow)
+  #:use-module (gnu packages ssh)
+  #:use-module (gnu packages base)
+  #:use-module (ice-9 match)
+  #:export (sysadmin?
+            sysadmin
+            sysadmin-service-type))
+
+;;; Commentary:
+;;;
+;;; Declaration of system administrator user accounts.
+;;;
+;;; Code:
+
+(define-record-type* <sysadmin> sysadmin make-sysadmin
+  sysadmin?
+  (name            sysadmin-name)
+  (full-name       sysadmin-full-name)
+  (lsh-public-key  sysadmin-lsh-public-key)
+  (restricted?     sysadmin-restricted? (default #f)))
+
+(define (sysadmin->account sysadmin)
+  "Return the user account for SYSADMIN."
+  (match sysadmin
+    (($ <sysadmin> name comment _ restricted?)
+     (user-account
+      (name name)
+      (comment comment)
+      (group "users")
+      (supplementary-groups (if restricted?
+                                '()
+                                '("wheel" "kvm"))) ;sudoer
+      (home-directory (string-append "/home/" name))))))
+
+(define (sysadmin-lsh-authorization sysadmin)
+  "Return a gexp that invokes 'lsh-authorize' for SYSADMIN."
+  (match sysadmin
+    (($ <sysadmin> name _ public-key)
+     #~(begin
+         (match (primitive-fork)
+           (0
+            (dynamic-wind
+              (const #t)
+              (lambda ()
+                (let* ((pw   (getpw #$name))
+                       (uid  (passwd:uid pw))
+                       (gid  (passwd:gid pw))
+                       (home (passwd:dir pw)))
+                  (setgroups #())
+                  (setgid gid)
+                  (setuid uid)
+
+                  ;; 'lsh-authorize' is a shell script so set up a couple of
+                  ;; environment variables.
+                  (setenv "HOME" home)
+                  (setenv "PATH" (string-append #$coreutils "/bin"))
+
+                  (format #t "registering lsh key for '~a' (UID ~a)...~%"
+                          #$name (getuid))
+                  (system* (string-append #$lsh "/bin/lsh-authorize")
+                           #$public-key)))
+              (lambda ()
+                (primitive-exit 0))))
+           (pid
+            (waitpid pid)))))))
+
+(define sysadmin-service-type
+  ;; The service that initializes sysadmin accounts.
+  (service-type
+   (name 'sysadmin)
+   (extensions (list (service-extension account-service-type
+                                        (lambda (lst)
+                                          (map sysadmin->account lst)))
+                     (service-extension activation-service-type
+                                        (lambda (lst)
+                                          #~(begin
+                                              (use-modules (ice-9 match))
+                                              #$@(map 
sysadmin-lsh-authorization
+                                                      lst))))))))
+
+;;; people.scm ends here