[bug#38182] [PATCH 0/3] Add PAM Mount.

[bug#38182] [PATCH 0/3] Add PAM Mount.

[Guillaume Le Vaillant]

This patch series adds a 'pam-mount-service-type' allowing to mount
volumes when logging in.

Patches:
 1- gnu: Add libhx.
 2- gnu: Add pam-mount.
 3- services: Add pam-mount.

[bug#38182] [PATCH 1/3] gnu: Add libhx.

[Guillaume Le Vaillant]

* gnu/packages/c.scm (libhx): New variable.
---
 gnu/packages/c.scm | 23 +++++++++++++++++++++++
 1 file changed, 23 insertions(+)

diff --git a/gnu/packages/c.scm b/gnu/packages/c.scm
index 41946f4169..77c87a2bb3 100644
--- a/gnu/packages/c.scm
+++ b/gnu/packages/c.scm
@@ -4,6 +4,7 @@
 ;;; Copyright © 2018 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;; Copyright © 2018, 2019 Pierre Neidhardt <mail@ambrevar.xyz>
 ;;; Copyright © 2019 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -316,3 +317,25 @@ Its three main components are:
      "The purpose of libfixposix is to offer replacements for parts of POSIX
 whose behaviour is inconsistent across *NIX flavours.")
     (license license:boost1.0)))
+
+(define-public libhx
+  (package
+    (name "libhx")
+    (version "3.24")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "mirror://sourceforge/libhx/libHX/"
+                           "libHX-" version ".tar.xz"))
+       (sha256
+        (base32
+         "0i8v2464p830c15myknvvs6bhxaf663lrqgga95l94ygfynkw6x5"))))
+    (build-system gnu-build-system)
+    (home-page "http://libhx.sourceforge.net")
+    (synopsis "C library with common data structures and functions")
+    (description
+     "This is a C library (with some C++ bindings available) that provides data
+structures and functions commonly needed, such as maps, deques, linked lists,
+string formatting and autoresizing, option and config file parsing, type
+checking casts and more.")
+    (license license:lgpl2.1+)))
-- 
2.24.0

[bug#38182] [PATCH 2/3] gnu: Add pam-mount.

[Guillaume Le Vaillant]

* gnu/packages/admin.scm (pam-mount): New variable.
* gnu/packages/patches/pam-mount-luks2-support.patch: New file.
* gnu/local.mk (dist_patch_DATA): Add it.
---
 gnu/local.mk                                  |  1 +
 gnu/packages/admin.scm                        | 68 +++++++++++++++++++
 .../patches/pam-mount-luks2-support.patch     | 51 ++++++++++++++
 3 files changed, 120 insertions(+)
 create mode 100644 gnu/packages/patches/pam-mount-luks2-support.patch

diff --git a/gnu/local.mk b/gnu/local.mk
index e1c1cef854..5fa7b5a883 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -1205,6 +1205,7 @@ dist_patch_DATA =						\
   %D%/packages/patches/p7zip-CVE-2016-9296.patch		\
   %D%/packages/patches/p7zip-CVE-2017-17969.patch		\
   %D%/packages/patches/p7zip-remove-unused-code.patch		\
+  %D%/packages/patches/pam-mount-luks2-support.patch		\
   %D%/packages/patches/patchutils-test-perms.patch		\
   %D%/packages/patches/patch-hurd-path-max.patch		\
   %D%/packages/patches/pcre2-fix-jit_match-crash.patch		\
diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index c4723c5a9d..5211fc7c36 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -27,6 +27,7 @@
 ;;; Copyright © 2019 Björn Höfling <bjoern.hoefling@bjoernhoefling.de>
 ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.lonestar.org>
 ;;; Copyright © 2019 Hartmut Goebel <h.goebel@crazy-compilers.com>
+;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -60,8 +61,10 @@
   #:use-module (gnu packages algebra)
   #:use-module (gnu packages base)
   #:use-module (gnu packages bash)
+  #:use-module (gnu packages c)
   #:use-module (gnu packages check)
   #:use-module (gnu packages crypto)
+  #:use-module (gnu packages cryptsetup)
   #:use-module (gnu packages cyrus-sasl)
   #:use-module (gnu packages dns)
   #:use-module (gnu packages file)
@@ -3452,3 +3455,68 @@ IGMP and Raw, across a wide variety of interface types, and understands BPF
 filter logic in the same fashion as more common packet sniffing tools, such as
 tcpdump and snoop.")
     (license license:bsd-3)))
+
+(define-public pam-mount
+  (package
+    (name "pam-mount")
+    (version "2.16")
+    (source
+     (origin
+       (method url-fetch)
+       (uri (string-append "mirror://sourceforge/pam-mount/pam_mount/"
+                           version "/pam_mount-" version ".tar.xz"))
+       (sha256
+        (base32
+         "1rvi4irb7ylsbhvx1cr6islm2xxw1a4b19q6z4a9864ndkm0f0mf"))
+       (patches
+        ;; Patch adding support for encrypted volumes in LUKS2 format.
+        ;; It comes from the Gentoo package definition for sys-auth/pam_mount.
+        (search-patches "pam-mount-luks2-support.patch"))))
+    (build-system gnu-build-system)
+    (native-inputs
+     `(("perl" ,perl)
+       ("pkg-config" ,pkg-config)))
+    (inputs
+     `(("cryptsetup" ,cryptsetup)
+       ("libhx" ,libhx)
+       ("libxml2" ,libxml2)
+       ("linux-pam" ,linux-pam)
+       ("lvm2" ,lvm2)
+       ("openssl" ,openssl)
+       ("pcre" ,pcre)
+       ("util-linux" ,util-linux)))
+    (arguments
+     `(#:configure-flags
+       (list (string-append "--with-slibdir=" %output "/lib")
+             (string-append "--with-ssbindir=" %output "/sbin"))
+       #:phases
+       (modify-phases %standard-phases
+         (add-after 'unpack 'fix-program-paths
+           (lambda* (#:key inputs outputs #:allow-other-keys)
+             (let ((util-linux (assoc-ref inputs "util-linux"))
+                   (out (assoc-ref outputs "out")))
+               (substitute* "src/mtcrypt.c"
+                 (("\"mount\";")
+                  (string-append "\"" util-linux "/bin/mount\";"))
+                 (("\"umount\";")
+                  (string-append "\"" util-linux "/bin/umount\";"))
+                 (("\"fsck\",")
+                  (string-append "\"" util-linux "/sbin/fsck\",")))
+               (substitute* "src/rdconf1.c"
+                 (("\"mount\", \"")
+                  (string-append "\"" util-linux "/bin/mount\", \""))
+                 (("\"umount\", \"")
+                  (string-append "\"" util-linux "/bin/umount\", \""))
+                 (("\"fsck\", \"")
+                  (string-append "\"" util-linux "/sbin/fsck\", \""))
+                 (("\"pmvarrun\", \"")
+                  (string-append "\"" out "/sbin/pmvarrun\", \""))))
+             #t)))))
+    (home-page "http://pam-mount.sourceforge.net")
+    (synopsis "PAM module to mount volumes for a user session")
+    (description
+     "Pam-mount is a PAM module that can mount volumes when a user logs in.
+It supports mounting local filesystems of any kind the normal mount utility
+supports.  It can also mount encrypted LUKS volumes using the password
+supplied by the user when logging in.")
+    (license (list license:gpl2+ license:lgpl2.1+))))
diff --git a/gnu/packages/patches/pam-mount-luks2-support.patch b/gnu/packages/patches/pam-mount-luks2-support.patch
new file mode 100644
index 0000000000..b59daf5ce1
--- /dev/null
+++ b/gnu/packages/patches/pam-mount-luks2-support.patch
@@ -0,0 +1,51 @@
+From d4434c05e7c0cf05d87089404cfa2deedc60811a Mon Sep 17 00:00:00 2001
+From: Ingo Franzki <ifranzki@linux.ibm.com>
+Date: Mon, 29 Oct 2018 16:47:40 +0100
+Subject: [PATCH] crypto: Add support for LUKS2
+
+Cryptsetup version 2.0 added support for LUKS2.
+This patch adds support for mounting LUKS2 volumes with
+pam_mount.
+
+Signed-off-by: Ingo Franzki <ifranzki@linux.ibm.com>
+---
+ src/crypto-dmc.c | 10 ++++++++--
+ 1 file changed, 8 insertions(+), 2 deletions(-)
+
+diff --git a/src/crypto-dmc.c b/src/crypto-dmc.c
+index d0ab6ca..abd0358 100644
+--- a/src/crypto-dmc.c
++++ b/src/crypto-dmc.c
+@@ -21,6 +21,12 @@
+ #include "libcryptmount.h"
+ #include "pam_mount.h"
+ 
++#ifndef CRYPT_LUKS
++	#define CRYPT_LUKS	NULL /* Passing NULL to crypt_load will
++					default to LUKS(1) on older
++					libcryptsetup versions. */
++#endif
++
+ /**
+  * dmc_is_luks - check if @path points to a LUKS volume (cf. normal dm-crypt)
+  * @path:	path to the crypto container
+@@ -48,7 +54,7 @@ EXPORT_SYMBOL int ehd_is_luks(const char *path, bool blkdev)
+ 
+ 	ret = crypt_init(&cd, device);
+ 	if (ret == 0) {
+-		ret = crypt_load(cd, CRYPT_LUKS1, NULL);
++		ret = crypt_load(cd, CRYPT_LUKS, NULL);
+ 		if (ret == -EINVAL)
+ 			ret = false;
+ 		else if (ret == 0)
+@@ -106,7 +112,7 @@ static bool dmc_run(const struct ehd_mount_request *req,
+ #endif
+ 	}
+ 
+-	ret = crypt_load(cd, CRYPT_LUKS1, NULL);
++	ret = crypt_load(cd, CRYPT_LUKS, NULL);
+ 	if (ret == 0) {
+ 		ret = crypt_activate_by_passphrase(cd, mt->crypto_name,
+ 		      CRYPT_ANY_SLOT, req->key_data, req->key_size, flags);
+-- 
+2.21.0
-- 
2.24.0

[bug#38182] [PATCH 3/3] services: Add pam-mount.

[Guillaume Le Vaillant]

* gnu/services/pam-mount.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (PAM Mount Service): New subsection.
---
 doc/guix.texi              | 31 ++++++++++++++++
 gnu/local.mk               |  1 +
 gnu/services/pam-mount.scm | 76 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 108 insertions(+)
 create mode 100644 gnu/services/pam-mount.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index 242beb18c8..3a339b42a0 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -68,6 +68,7 @@ Copyright @copyright{} 2019 Ivan Petkov@*
 Copyright @copyright{} 2019 Jakob L. Kreuze@*
 Copyright @copyright{} 2019 Kyle Andrews@*
 Copyright @copyright{} 2019 Alex Griffin@*
+Copyright @copyright{} 2019 Guillaume Le Vaillant@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -304,6 +305,7 @@ Services
 * Virtualization Services::     Virtualization services.
 * Version Control Services::    Providing remote access to Git repositories.
 * Game Services::               Game servers.
+* PAM Mount Service::           Service to mount volumes when logging in.
 * Miscellaneous Services::      Other services.
 
 Defining Services
@@ -11867,6 +11869,7 @@ declaration.
 * Virtualization Services::     Virtualization services.
 * Version Control Services::    Providing remote access to Git repositories.
 * Game Services::               Game servers.
+* PAM Mount Service::           Service to mount volumes when logging in.
 * Guix Services::               Services relating specifically to Guix.
 * Miscellaneous Services::      Other services.
 @end menu
@@ -24592,6 +24595,34 @@ The port to bind the server to.
 @end deftp
 
 
+@node PAM Mount Service
+@subsection PAM Mount Service
+@cindex pam-mount
+
+The @code{(gnu services pam-mount)} module provides a service allowing
+users to mount volumes when they log in.  It should be able to mount any
+volume format supported by the system.  Note that to automatically mount
+encrypted volumes using the password the user entered to log in, the
+@code{pam-mount} package must be added in the @code{packages} field of
+the @code{operating-system} definition.
+
+@defvar {Scheme Variable} pam-mount-service-type
+Service type for PAM Mount support.
+@end defvar
+
+@deftp {Data Type} pam-mount-configuration
+Data type representing the configuration of PAM Mount.
+
+It takes the following parameters:
+
+@table @asis
+@item @code{file}
+The configuration file that will be placed in
+@file{/etc/security/pam_mount.conf.xml}.
+@end table
+@end deftp
+
+
 @node Guix Services
 @subsection Guix Services
 
diff --git a/gnu/local.mk b/gnu/local.mk
index 5fa7b5a883..43ef679935 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -551,6 +551,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/services/networking.scm			\
   %D%/services/nix.scm				\
   %D%/services/nfs.scm			\
+  %D%/services/pam-mount.scm			\
   %D%/services/security-token.scm		\
   %D%/services/shepherd.scm			\
   %D%/services/sound.scm			\
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
new file mode 100644
index 0000000000..65db9b0068
--- /dev/null
+++ b/gnu/services/pam-mount.scm
@@ -0,0 +1,76 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix 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.
+;;;
+;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services pam-mount)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu services)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu system pam)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:export (pam-mount-configuration
+            pam-mount-configuration?
+            pam-mount-service-type))
+
+(define %pam-mount-default-configuration
+  (plain-file "pam_mount.conf.xml"
+              "<?xml version=\"1.0\" encoding=\"utf-8\" ?>
+<!DOCTYPE pam_mount SYSTEM \"pam_mount.conf.xml.dtd\">
+<pam_mount>
+<debug enable=\"0\" />
+<mntoptions
+allow=\"nosuid,nodev,loop,encryption,fsck,nonempty,allow_root,allow_other\" />
+<mntoptions require=\"nosuid,nodev\" />
+<logout wait=\"0\" hup=\"no\" term=\"no\" kill=\"no\" />
+<mkmountpoint enable=\"1\" remove=\"true\" />
+</pam_mount>\n"))
+
+(define-record-type* <pam-mount-configuration>
+  pam-mount-configuration
+  make-pam-mount-configuration
+  pam-mount-configuration?
+  (file pam-mount-configuration-file
+        (default %pam-mount-default-configuration)))
+
+(define (pam-mount-etc-service config)
+  `(("security/pam_mount.conf.xml" ,(pam-mount-configuration-file config))))
+
+(define (pam-mount-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
+  (list (lambda (pam)
+          (if (member (pam-service-name pam)
+                      '("login" "su" "slim" "gdm-password"))
+              (pam-service
+               (inherit pam)
+               (auth (append (pam-service-auth pam)
+                             (list optional-pam-mount)))
+               (session (append (pam-service-session pam)
+                                (list optional-pam-mount))))
+              pam))))
+
+(define pam-mount-service-type
+  (service-type
+   (name 'pam-mount)
+   (extensions (list (service-extension etc-service-type
+                                        pam-mount-etc-service)
+                     (service-extension pam-root-service-type
+                                        pam-mount-pam-service)))
+   (default-value (pam-mount-configuration))))
-- 
2.24.0

[bug#38182] [PATCH 3/3] services: Add pam-mount.

[Ludovic Courtès]

Hi Guillaume,

I’ve applied the first two patches, thanks!

Guillaume Le Vaillant <glv@posteo.net> skribis:

> * gnu/services/pam-mount.scm: New file.
> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
> * doc/guix.texi (PAM Mount Service): New subsection.

[…]

> +The @code{(gnu services pam-mount)} module provides a service allowing
> +users to mount volumes when they log in.  It should be able to mount any
> +volume format supported by the system.

How does one specify what needs to be mounted upon log-in of a specific
user?  I’m new to PAM-Mount and I’m left wondering.  :-)

> Note that to automatically mount
> +encrypted volumes using the password the user entered to log in, the
> +@code{pam-mount} package must be added in the @code{packages} field of
> +the @code{operating-system} definition.

Should we instead arrange so that the ‘pam-mount’ command (or whatever
it’s called) is automatically found, instead of asking users to add it
to ‘packages’?

Perhaps the manual should give an example for the global config file,
too?

> +(define %pam-mount-default-configuration
> +  (plain-file "pam_mount.conf.xml"
> +              "<?xml version=\"1.0\" encoding=\"utf-8\" ?>
> +<!DOCTYPE pam_mount SYSTEM \"pam_mount.conf.xml.dtd\">
> +<pam_mount>
> +<debug enable=\"0\" />
> +<mntoptions
> +allow=\"nosuid,nodev,loop,encryption,fsck,nonempty,allow_root,allow_other\" />
> +<mntoptions require=\"nosuid,nodev\" />
> +<logout wait=\"0\" hup=\"no\" term=\"no\" kill=\"no\" />
> +<mkmountpoint enable=\"1\" remove=\"true\" />
> +</pam_mount>\n"))

I suggest writing SXML instead and using ‘sxml->xml’, if you don’t
mind.  :-)

> +(define pam-mount-service-type
> +  (service-type
> +   (name 'pam-mount)
> +   (extensions (list (service-extension etc-service-type
> +                                        pam-mount-etc-service)
> +                     (service-extension pam-root-service-type
> +                                        pam-mount-pam-service)))
> +   (default-value (pam-mount-configuration))))

Please also add a ‘description’ field.

Could you send an updated patch?

Thanks!

Ludo’.

[bug#38182] [PATCH 3/3] services: Add pam-mount.

[Guillaume Le Vaillant]

[-- Attachment #1: Type: text/plain, Size: 2487 bytes --]


Ludovic Courtès skribis:

> Hi Guillaume,
>
> I’ve applied the first two patches, thanks!
>
> Guillaume Le Vaillant <glv@posteo.net> skribis:
>
>> * gnu/services/pam-mount.scm: New file.
>> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
>> * doc/guix.texi (PAM Mount Service): New subsection.
>
> […]
>
>> +The @code{(gnu services pam-mount)} module provides a service allowing
>> +users to mount volumes when they log in.  It should be able to mount any
>> +volume format supported by the system.
>
> How does one specify what needs to be mounted upon log-in of a specific
> user?  I’m new to PAM-Mount and I’m left wondering.  :-)

I added an example in the manual.

>> Note that to automatically mount
>> +encrypted volumes using the password the user entered to log in, the
>> +@code{pam-mount} package must be added in the @code{packages} field of
>> +the @code{operating-system} definition.
>
> Should we instead arrange so that the ‘pam-mount’ command (or whatever
> it’s called) is automatically found, instead of asking users to add it
> to ‘packages’?

I found a way to have 'pam-mount' call directly
'/gnu/store/...-pam-mount-.../sbin/mount.crypt' when necessary. So
adding 'pam-mount' to 'packages' is not needed anymore.

>> +(define %pam-mount-default-configuration
>> +  (plain-file "pam_mount.conf.xml"
>> +              "<?xml version=\"1.0\" encoding=\"utf-8\" ?>
>> +<!DOCTYPE pam_mount SYSTEM \"pam_mount.conf.xml.dtd\">
>> +<pam_mount>
>> +<debug enable=\"0\" />
>> +<mntoptions
>> +allow=\"nosuid,nodev,loop,encryption,fsck,nonempty,allow_root,allow_other\" />
>> +<mntoptions require=\"nosuid,nodev\" />
>> +<logout wait=\"0\" hup=\"no\" term=\"no\" kill=\"no\" />
>> +<mkmountpoint enable=\"1\" remove=\"true\" />
>> +</pam_mount>\n"))
>
> I suggest writing SXML instead and using ‘sxml->xml’, if you don’t
> mind.  :-)

Done.

>> +(define pam-mount-service-type
>> +  (service-type
>> +   (name 'pam-mount)
>> +   (extensions (list (service-extension etc-service-type
>> +                                        pam-mount-etc-service)
>> +                     (service-extension pam-root-service-type
>> +                                        pam-mount-pam-service)))
>> +   (default-value (pam-mount-configuration))))
>
> Please also add a ‘description’ field.

Done.

> Could you send an updated patch?
>
> Thanks!
>
> Ludo’.

Updated patch attached.


[-- Attachment #2: 0001-services-Add-pam-mount.patch --]
[-- Type: text/x-patch, Size: 10341 bytes --]

From 4572adf4f28480fd891293ff2204228dbb8b41d1 Mon Sep 17 00:00:00 2001
From: Guillaume Le Vaillant <glv@posteo.net>
Date: Tue, 26 Nov 2019 21:56:44 +0100
Subject: [PATCH v2 3/3] services: Add pam-mount.

* gnu/services/pam-mount.scm: New file.
* gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
* doc/guix.texi (PAM Mount Service): New subsection.
---
 doc/guix.texi              |  85 ++++++++++++++++++++++++++++
 gnu/local.mk               |   1 +
 gnu/services/pam-mount.scm | 111 +++++++++++++++++++++++++++++++++++++
 3 files changed, 197 insertions(+)
 create mode 100644 gnu/services/pam-mount.scm

diff --git a/doc/guix.texi b/doc/guix.texi
index a64b0fb84c..b293adb0b1 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -68,6 +68,7 @@ Copyright @copyright{} 2019 Ivan Petkov@*
 Copyright @copyright{} 2019 Jakob L. Kreuze@*
 Copyright @copyright{} 2019 Kyle Andrews@*
 Copyright @copyright{} 2019 Alex Griffin@*
+Copyright @copyright{} 2019 Guillaume Le Vaillant@*
 
 Permission is granted to copy, distribute and/or modify this document
 under the terms of the GNU Free Documentation License, Version 1.3 or
@@ -305,6 +306,7 @@ Services
 * Virtualization Services::     Virtualization services.
 * Version Control Services::    Providing remote access to Git repositories.
 * Game Services::               Game servers.
+* PAM Mount Service::           Service to mount volumes when logging in.
 * Miscellaneous Services::      Other services.
 
 Defining Services
@@ -11931,6 +11933,7 @@ declaration.
 * Virtualization Services::     Virtualization services.
 * Version Control Services::    Providing remote access to Git repositories.
 * Game Services::               Game servers.
+* PAM Mount Service::           Service to mount volumes when logging in.
 * Guix Services::               Services relating specifically to Guix.
 * Miscellaneous Services::      Other services.
 @end menu
@@ -24656,6 +24659,88 @@ The port to bind the server to.
 @end deftp
 
 
+@node PAM Mount Service
+@subsection PAM Mount Service
+@cindex pam-mount
+
+The @code{(gnu services pam-mount)} module provides a service allowing
+users to mount volumes when they log in.  It should be able to mount any
+volume format supported by the system.
+
+@defvar {Scheme Variable} pam-mount-service-type
+Service type for PAM Mount support.
+@end defvar
+
+@deftp {Data Type} pam-mount-configuration
+Data type representing the configuration of PAM Mount.
+
+It takes the following parameters:
+
+@table @asis
+@item @code{rules}
+The configuration rules that will be used to generate
+@file{/etc/security/pam_mount.conf.xml}.
+
+The configuration rules are SXML elements, and the the default ones
+don't mount anything for anyone at login:
+
+@lisp
+`((debug (@@ (enable "0")))
+  (mntoptions (@@ (allow ,(string-join
+                          '("nosuid" "nodev" "loop"
+                            "encryption" "fsck" "nonempty"
+                            "allow_root" "allow_other")
+                          ","))))
+  (mntoptions (@@ (require "nosuid,nodev")))
+  (logout (@@ (wait "0")
+             (hup "0")
+             (term "no")
+             (kill "no")))
+  (mkmountpoint (@@ (enable "1")
+                   (remove "true"))))
+@end lisp
+
+Some @code{volume} elements must be added to automatically mount volumes
+at login.  Here's an example allowing the user @code{alice} to mount her
+encrypted @code{HOME} directory and allowing the user @code{bob} to mount
+the partition where he stores his data:
+
+@lisp
+(define pam-mount-rules
+`((debug (@@ (enable "0")))
+            (volume (@@ (user "alice")
+                       (fstype "crypt")
+                       (path "/dev/sda2")
+                       (mountpoint "/home/alice")))
+            (volume (@@ (user "bob")
+                       (fstype "auto")
+                       (path "/dev/sdb3")
+                       (mountpoint "/home/bob/data")
+                       (options "defaults,autodefrag,compress")))
+            (mntoptions (@@ (allow ,(string-join
+                                    '("nosuid" "nodev" "loop"
+                                      "encryption" "fsck" "nonempty"
+                                      "allow_root" "allow_other")
+                                    ","))))
+            (mntoptions (@@ (require "nosuid,nodev")))
+            (logout (@@ (wait "0")
+                       (hup "0")
+                       (term "no")
+                       (kill "no")))
+            (mkmountpoint (@@ (enable "1")
+                             (remove "true")))))
+
+(service pam-mount-service-type
+         (pam-mount-configuration
+           (rules pam-mount-rules)))
+@end lisp
+
+The complete list of possible options can be found in the man page for
+@uref{http://pam-mount.sourceforge.net/pam_mount.conf.5.html, pam_mount.conf}.
+@end table
+@end deftp
+
+
 @node Guix Services
 @subsection Guix Services
 
diff --git a/gnu/local.mk b/gnu/local.mk
index 0129e42944..0e0c3e30e7 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -551,6 +551,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/services/networking.scm			\
   %D%/services/nix.scm				\
   %D%/services/nfs.scm			\
+  %D%/services/pam-mount.scm			\
   %D%/services/security-token.scm		\
   %D%/services/shepherd.scm			\
   %D%/services/sound.scm			\
diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm
new file mode 100644
index 0000000000..98611462c2
--- /dev/null
+++ b/gnu/services/pam-mount.scm
@@ -0,0 +1,111 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2019 Guillaume Le Vaillant <glv@posteo.net>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix 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.
+;;;
+;;; GNU Guix 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 GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (gnu services pam-mount)
+  #:use-module (gnu packages admin)
+  #:use-module (gnu services)
+  #:use-module (gnu services configuration)
+  #:use-module (gnu system pam)
+  #:use-module (guix gexp)
+  #:use-module (guix records)
+  #:export (pam-mount-configuration
+            pam-mount-configuration?
+            pam-mount-service-type))
+
+(define %pam-mount-default-configuration
+  `((debug (@ (enable "0")))
+    (mntoptions (@ (allow ,(string-join
+                            '("nosuid" "nodev" "loop"
+                              "encryption" "fsck" "nonempty"
+                              "allow_root" "allow_other")
+                            ","))))
+    (mntoptions (@ (require "nosuid,nodev")))
+    (logout (@ (wait "0")
+               (hup "0")
+               (term "no")
+               (kill "no")))
+    (mkmountpoint (@ (enable "1")
+                     (remove "true")))))
+
+(define (make-pam-mount-configuration-file config)
+  (computed-file
+   "pam_mount.conf.xml"
+   #~(begin
+       (use-modules (sxml simple))
+       (call-with-output-file #$output
+         (lambda (port)
+           (sxml->xml
+            '(*TOP*
+              (*PI* xml "version='1.0' encoding='utf-8'")
+              (pam_mount
+               #$@(pam-mount-configuration-rules config)
+               (pmvarrun
+                #$(file-append pam-mount
+                               "/sbin/pmvarrun -u '%(USER)' -o '%(OPERATION)'"))
+               (cryptmount
+                #$(file-append pam-mount
+                               (string-append
+                                "/sbin/mount.crypt"
+                                " '%(if %(CIPHER),-ocipher=%(CIPHER))'"
+                                " '%(if %(FSKEYCIPHER),"
+                                "-ofsk_cipher=%(FSKEYCIPHER))'"
+                                " '%(if %(FSKEYHASH),-ofsk_hash=%(FSKEYHASH))'"
+                                " '%(if %(FSKEYPATH),-okeyfile=%(FSKEYPATH))'"
+                                " '%(if %(OPTIONS),-o%(OPTIONS))'"
+                                " '%(VOLUME)' '%(MNTPT)'")))
+               (cryptumount
+                #$(file-append pam-mount "/sbin/umount.crypt '%(MNTPT)'"))))
+            port))))))
+
+(define-record-type* <pam-mount-configuration>
+  pam-mount-configuration
+  make-pam-mount-configuration
+  pam-mount-configuration?
+  (rules pam-mount-configuration-rules
+         (default %pam-mount-default-configuration)))
+
+(define (pam-mount-etc-service config)
+  `(("security/pam_mount.conf.xml"
+     ,(make-pam-mount-configuration-file config))))
+
+(define (pam-mount-pam-service config)
+  (define optional-pam-mount
+    (pam-entry
+     (control "optional")
+     (module #~(string-append #$pam-mount "/lib/security/pam_mount.so"))))
+  (list (lambda (pam)
+          (if (member (pam-service-name pam)
+                      '("login" "su" "slim" "gdm-password"))
+              (pam-service
+               (inherit pam)
+               (auth (append (pam-service-auth pam)
+                             (list optional-pam-mount)))
+               (session (append (pam-service-session pam)
+                                (list optional-pam-mount))))
+              pam))))
+
+(define pam-mount-service-type
+  (service-type
+   (name 'pam-mount)
+   (extensions (list (service-extension etc-service-type
+                                        pam-mount-etc-service)
+                     (service-extension pam-root-service-type
+                                        pam-mount-pam-service)))
+   (default-value (pam-mount-configuration))
+   (description "Activate PAM-Mount support.  It allows mounting volumes for
+specific users when they log in.")))
-- 
2.24.0

bug#38182: [PATCH 3/3] services: Add pam-mount.

[Ludovic Courtès]

Hi,

Guillaume Le Vaillant <glv@posteo.net> skribis:

>>From 4572adf4f28480fd891293ff2204228dbb8b41d1 Mon Sep 17 00:00:00 2001
> From: Guillaume Le Vaillant <glv@posteo.net>
> Date: Tue, 26 Nov 2019 21:56:44 +0100
> Subject: [PATCH v2 3/3] services: Add pam-mount.
>
> * gnu/services/pam-mount.scm: New file.
> * gnu/local.mk (GNU_SYSTEM_MODULES): Add it.
> * doc/guix.texi (PAM Mount Service): New subsection.

Applied, thanks!

I forgot to mention it before but you should consider writing a test for
this service in (gnu tests …).  That will ease maintenance over time and
will make it easy to see whether a change breaks the service.

Thank you,
Ludo’.