gnu/services/pam-mount.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu services pam-mount)
  20   #:use-module (gnu packages admin)
  21   #:use-module (gnu services)
  22   #:use-module (gnu services configuration)
  23   #:use-module (gnu system pam)
  24   #:use-module (guix gexp)
  25   #:use-module (guix records)
  26   #:export (pam-mount-configuration
  27             pam-mount-configuration?
  28             pam-mount-service-type))
  29
  30 (define %pam-mount-default-configuration
  31   `((debug (@ (enable "0")))
  32     (mntoptions (@ (allow ,(string-join
  33                             '("nosuid" "nodev" "loop"
  34                               "encryption" "fsck" "nonempty"
  35                               "allow_root" "allow_other")
  36                             ","))))
  37     (mntoptions (@ (require "nosuid,nodev")))
  38     (logout (@ (wait "0")
  39                (hup "0")
  40                (term "no")
  41                (kill "no")))
  42     (mkmountpoint (@ (enable "1")
  43                      (remove "true")))))
  44
  45 (define (make-pam-mount-configuration-file config)
  46   (computed-file
  47    "pam_mount.conf.xml"
  48    #~(begin
  49        (use-modules (sxml simple))
  50        (call-with-output-file #$output
  51          (lambda (port)
  52            (sxml->xml
  53             '(*TOP*
  54               (*PI* xml "version='1.0' encoding='utf-8'")
  55               (pam_mount
  56                #$@(pam-mount-configuration-rules config)
  57                (pmvarrun
  58                 #$(file-append pam-mount
  59                                "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))
  60                (cryptmount
  61                 #$(file-append pam-mount
  62                                (string-append
  63                                 "/sbin/mount.crypt"
  64                                 " '%(if %(CIPHER),-ocipher=%(CIPHER))'"
  65                                 " '%(if %(FSKEYCIPHER),"
  66                                 "-ofsk_cipher=%(FSKEYCIPHER))'"
  67                                 " '%(if %(FSKEYHASH),-ofsk_hash=%(FSKEYHASH))'"
  68                                 " '%(if %(FSKEYPATH),-okeyfile=%(FSKEYPATH))'"
  69                                 " '%(if %(OPTIONS),-o%(OPTIONS))'"
  70                                 " '%(VOLUME)' '%(MNTPT)'")))
  71                (cryptumount
  72                 #$(file-append pam-mount "/sbin/umount.crypt '%(MNTPT)'"))))
  73             port))))))
  74
  75 (define-record-type* <pam-mount-configuration>
  76   pam-mount-configuration
  77   make-pam-mount-configuration
  78   pam-mount-configuration?
  79   (rules pam-mount-configuration-rules
  80          (default %pam-mount-default-configuration)))
  81
  82 (define (pam-mount-etc-service config)
  83   `(("security/pam_mount.conf.xml"
  84      ,(make-pam-mount-configuration-file config))))
  85
  86 (define (pam-mount-pam-service config)
  87   (define optional-pam-mount
  88     (pam-entry
  89      (control "optional")
  90      (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
  91   (list (lambda (pam)
  92           (if (member (pam-service-name pam)
  93                       '("login" "su" "slim" "gdm-password"))
  94               (pam-service
  95                (inherit pam)
  96                (auth (append (pam-service-auth pam)
  97                              (list optional-pam-mount)))
  98                (session (append (pam-service-session pam)
  99                                 (list optional-pam-mount))))
 100               pam))))
 101
 102 (define pam-mount-service-type
 103   (service-type
 104    (name 'pam-mount)
 105    (extensions (list (service-extension etc-service-type
 106                                         pam-mount-etc-service)
 107                      (service-extension pam-root-service-type
 108                                         pam-mount-pam-service)))
 109    (default-value (pam-mount-configuration))
 110    (description "Activate PAM-Mount support.  It allows mounting volumes for
 111 specific users when they log in.")))