~ruther/guix-local

a843fe2222fec5f162a94da8836b803cd7e0c7ff — Ludovic Courtès 12 years ago 3b07625
gnu: vm: Setup PAM.

* gnu/system/vm.scm (example2): Use 'pam-services->directory'.  Change
  POPULATE to create /etc/pam.d, /etc/login.defs, and /var/run.  Change
  BOOT to spawn syslogd; boot to Bash.  Add inputs.
1 files changed, 43 insertions(+), 20 deletions(-)

M gnu/system/vm.scm
M gnu/system/vm.scm => gnu/system/vm.scm +43 -20
@@ 33,8 33,7 @@
  #:use-module (gnu packages linux-initrd)
  #:use-module ((gnu packages make-bootstrap)
                #:select (%guile-static-stripped))
  #:use-module ((gnu packages system)
                #:select (mingetty))
  #:use-module (gnu packages system)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (ice-9 match)


@@ 396,6 395,11 @@ is a /etc/passwd file."
      (lambda ()
        (set! store (open-connection)))
      (lambda ()
        (define %pam-services
          ;; Services known to PAM.
          (list %pam-other-services
                (unix-pam-service "login" #:allow-empty-passwords? #t)))

        (parameterize ((%guile-for-build (package-derivation store guile-final)))
          (let* ((bash-drv  (package-derivation store bash))
                 (bash-file (string-append (derivation-path->output-path bash-drv)


@@ 404,17 408,26 @@ is a /etc/passwd file."
                                          "/" bash-file)))
                 (passwd    (passwd-file store accounts))
                 (shadow    (passwd-file store accounts #:shadow? #t))
                 (pam.d-drv (pam-services->directory store %pam-services))
                 (pam.d     (derivation-path->output-path pam.d-drv))
                 (populate
                  (add-text-to-store store "populate-qemu-image"
                                     (object->string
                                      `(begin
                                         (mkdir-p "etc")
                                         (symlink ,shadow "etc/shadow")
                                         (symlink ,passwd "etc/passwd")))
                                         (symlink ,passwd "etc/passwd")
                                         (symlink "/dev/null"
                                                  "etc/login.defs")
                                         (symlink ,pam.d "etc/pam.d")
                                         (mkdir-p "var/run")))
                                     (list passwd)))
                 (out   (derivation-path->output-path
                         (package-derivation store mingetty)))
                 (getty (string-append out "/sbin/mingetty"))
                 (iu-drv  (package-derivation store inetutils))
                 (syslogd (string-append (derivation-path->output-path iu-drv)
                                         "/libexec/syslogd"))
                 (boot  (add-text-to-store store "boot"
                                           (object->string
                                            `(begin


@@ 423,9 436,15 @@ is a /etc/passwd file."
                                               ;; 'TIOCSCTTY'.
                                               (setsid)

                                               ;; Directly into mingetty.
                                               (execl ,getty "mingetty"
                                                      "--noclear" "tty1")))
                                               (when (zero? (primitive-fork))
                                                 (format #t "starting syslogd as ~a~%"
                                                         (getpid))
                                                 (execl ,syslogd "syslogd"))

                                               ;; Directly into mingetty. XXX
                                               ;; (execl ,getty "mingetty"
                                               ;;        "--noclear" "tty1")
                                               (execl ,bash-file "bash")))
                                           (list out)))
                 (entries  (list (menu-entry
                                  (label "Boot-to-Guile! (GNU System technology preview)")


@@ 434,20 453,24 @@ is a /etc/passwd file."
                                                     ,(string-append "--load=" boot)))
                                  (initrd gnu-system-initrd))))
                 (grub.cfg (grub-configuration-file store entries)))
           (qemu-image store
                       #:grub-configuration grub.cfg
                       #:populate populate
                       #:disk-image-size (* 400 (expt 2 20))
                       #:inputs-to-copy `(("boot" ,boot)
                                          ("linux" ,linux-libre)
                                          ("initrd" ,gnu-system-initrd)
                                          ("coreutils" ,coreutils)
                                          ("bash" ,bash)
                                          ("guile" ,guile-2.0)
                                          ("mingetty" ,mingetty)

                                          ("etc-passwd" ,passwd)
                                          ("etc-shadow" ,shadow))))))
            (build-derivations store (list pam.d-drv))
            (qemu-image store
                        #:grub-configuration grub.cfg
                        #:populate populate
                        #:disk-image-size (* 400 (expt 2 20))
                        #:inputs-to-copy `(("boot" ,boot)
                                           ("linux" ,linux-libre)
                                           ("initrd" ,gnu-system-initrd)
                                           ("coreutils" ,coreutils)
                                           ("bash" ,bash)
                                           ("guile" ,guile-2.0)
                                           ("mingetty" ,mingetty)
                                           ("inetutils" ,inetutils)

                                           ;; Configuration.
                                           ("etc-pam.d" ,pam.d)
                                           ("etc-passwd" ,passwd)
                                           ("etc-shadow" ,shadow))))))
      (lambda ()
        (close-connection store)))))