Commit | Line | Data |
---|---|---|
c1c6650e GLV |
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) | |
530e0f02 | 93 | '("login" "greetd" "su" "slim" "gdm-password" "sddm")) |
c1c6650e GLV |
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."))) |