From patchwork Thu May 1 13:42:35 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Felix Lechner X-Patchwork-Id: 42211 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 50A1627BC49; Thu, 1 May 2025 14:43:19 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 5167027BC49 for ; Thu, 1 May 2025 14:43:09 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uAUBs-0006i6-Vr; Thu, 01 May 2025 09:43:05 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1uAUBr-0006ho-Bo for guix-patches@gnu.org; Thu, 01 May 2025 09:43:03 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1uAUBr-00025K-2W for guix-patches@gnu.org; Thu, 01 May 2025 09:43:03 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=/fHeXqV3Z5sXYOMIzK+6egw1JDlINDTr0zpQ5hsdpAA=; b=siqaBnRve7/p2sJbTrIZIxJTP8hdBdH8hLR7dzcG0NfnCsES2+0PDBpij3qgnk3fFno9GUa5qdnK0vBiDjtvl/iL610gU7w7F9UDAiz9aPBG+njGnkxdneOuBUxG4b1ujZxRd5LTme3Fdw+y4lRMxrEkUYc7m87ieZ/oJ4AE7o1Qe5598wwpdBwDdmwNc2cJlqwDj896ryem6ThD5oFDi1XvfK8CcF06C+f7ji+foQB0Jpymagb5iSrotYIi3kTYjQnOcI+u+sO5jiq4zub7iTFX9i4D5BhgM73acTIywOz/cbCNXWsGq2PJ4YaJzNdWiG2w/8Nj11H3WF82jRxYcQ==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uAUBq-0001J9-Sz; Thu, 01 May 2025 09:43:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#72316] [PATCH v2 1/3] Add guile-pam. Resent-From: Felix Lechner Original-Sender: "Debbugs-submit" Resent-CC: leo@famulari.name, w@wmeyer.eu, guix-patches@gnu.org Resent-Date: Thu, 01 May 2025 13:43:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72316 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 72316@debbugs.gnu.org Cc: Maxim Cournoyer , Ludovic =?utf-8?q?Court?= =?utf-8?q?=C3=A8s?= , Z572 , Florian Pelz , Felix Lechner , Matthew Trzcinski , Leo Famulari , Wilko Meyer X-Debbugs-Original-Xcc: Leo Famulari , Wilko Meyer Received: via spool by 72316-submit@debbugs.gnu.org id=B72316.17461069795007 (code B ref 72316); Thu, 01 May 2025 13:43:02 +0000 Received: (at 72316) by debbugs.gnu.org; 1 May 2025 13:42:59 +0000 Received: from localhost ([127.0.0.1]:49841 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uAUBm-0001Ie-Sp for submit@debbugs.gnu.org; Thu, 01 May 2025 09:42:59 -0400 Received: from sail-ipv4.us-core.com ([208.82.101.137]:33450) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uAUBj-0001I8-N9 for 72316@debbugs.gnu.org; Thu, 01 May 2025 09:42:56 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=simple/simple; s=2017; bh=2n3KExTpnNjeJL6 +PepF9pvPo2XuvTFdY9ob4yFF6hw=; h=references:in-reply-to:date:subject: cc:to:from; d=lease-up.com; b=AhsfleZ6XXDK9+XeN8yG5m0IYDyyUWx+Sn8NIL5L m90hoL0/+dYlyQmcRlxFMwes5B7059PeuXJz6wPamOjCW1z+au9h8TI68VyNVCBP9WNs4s xqNrYbnCn6W/HX1dVy5tp7OYBnFlJBG/om/vsBVR8w0vjt6brhELsfhR+5SEQ= Received: by sail-ipv4.us-core.com (OpenSMTPD) with ESMTPSA id dcd2c8d3 (TLSv1.3:TLS_AES_256_GCM_SHA384:256:NO); Thu, 1 May 2025 13:42:55 +0000 (UTC) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 2a763324; Thu, 1 May 2025 13:42:55 +0000 (UTC) Date: Thu, 1 May 2025 06:42:35 -0700 Message-ID: X-Mailer: git-send-email 2.49.0 In-Reply-To: <878qnj80pt.fsf@iscas.ac.cn> References: <878qnj80pt.fsf@iscas.ac.cn> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-to: Felix Lechner X-ACL-Warn: , Felix Lechner via Guix-patches X-Patchwork-Original-From: Felix Lechner via Guix-patches via From: Felix Lechner Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches Change-Id: I991ca32c8696de0e6751b0f4225bf24151ba22f2 --- gnu/packages/linux.scm | 71 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 71 insertions(+) diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm index b4adf0c2b43..35ae4558043 100644 --- a/gnu/packages/linux.scm +++ b/gnu/packages/linux.scm @@ -113,6 +113,7 @@ (define-module (gnu packages linux) #:use-module (gnu packages bash) #:use-module (gnu packages bison) #:use-module (gnu packages boost) + #:use-module (gnu packages build-tools) #:use-module (gnu packages calendar) #:use-module (gnu packages check) #:use-module (gnu packages cpio) @@ -145,6 +146,7 @@ (define-module (gnu packages linux) #:use-module (gnu packages graphviz) #:use-module (gnu packages gstreamer) #:use-module (gnu packages gtk) + #:use-module (gnu packages guile) #:use-module (gnu packages haskell-apps) #:use-module (gnu packages haskell-xyz) #:use-module (gnu packages image) @@ -158,6 +160,7 @@ (define-module (gnu packages linux) #:use-module (gnu packages m4) #:use-module (gnu packages man) #:use-module (gnu packages maths) + #:use-module (gnu packages mes) #:use-module (gnu packages multiprecision) #:use-module (gnu packages ncurses) #:use-module (gnu packages netpbm) @@ -2412,6 +2415,74 @@ (define-public vendor-reset-linux-module ;;; Pluggable authentication modules (PAM). ;;; +(define-public guile-pam + (let ((commit "5ea70a5d88e7ade27ba9f231acab7d363b6400fb") + (revision "0")) + (package + (name "guile-pam") + (version (git-version "0.0" revision commit)) + (source (origin + (method git-fetch) + (uri (git-reference + (url "https://codeberg.org/lechner/guile-pam") + (commit commit))) + (file-name (git-file-name name version)) + (sha256 + (base32 + "1i034f42wnmnsz76pcniif2ikpbamh0cki3ib2zwmbnvif4656av")))) + (native-inputs (list + autoconf + automake + gnulib + guile-3.0 + libtool + linux-pam + nyacc-2.01 + pkg-config + texinfo)) + (inputs (list + guile-3.0 + linux-pam)) + (propagated-inputs (list + nyacc-2.01)) + (build-system gnu-build-system) + (arguments + (list + #:make-flags + #~(list (string-append "ENTRY_POINT_DIR=" #$output "/share/entry-points")) + #:phases + #~(modify-phases %standard-phases + (add-after 'unpack 'install-gnulib + ;; per https://lists.gnu.org/archive/html/guile-devel/2012-08/msg00042.html + (lambda* (#:key inputs #:allow-other-keys) + (let ((gnulib-build-aux (dirname + (search-input-file inputs + "/src/gnulib/build-aux/config.rpath")))) + (mkdir-p "build-aux") + (copy-recursively gnulib-build-aux "build-aux")) + (let ((gnulib-m4 (dirname (search-input-file inputs + "/src/gnulib/m4/lib-link.m4")))) + (mkdir-p "m4") + (copy-recursively gnulib-m4 "m4")))) + (add-after 'patch-source-shebangs 'fix-paths + (lambda* (#:key inputs #:allow-other-keys) + (for-each (lambda (file) + (substitute* file + (("/usr/bin/env -S guile ") + (string-append (search-input-file inputs "/bin/guile") " \\\n")))) + '("test/legacy-control-strings")) + (substitute* "scm/pam.scm" + (("[.]/wrap/c/[.]libs/conversation.so") + (string-append #$output "/lib/guile-pam/wrapper/conversation.so")))))))) + (home-page "https://codeberg.org/lechner/guile-pam") + (synopsis "Write your Linux-PAM authentication logic in Guile Scheme") + (description + "Guile-PAM provides a way to rewrite your authentication logic in the +Linux PAM (pluggable authentication modules) in Guile Scheme. It should make +those modules more transparent to the administrator and more intuitive to +use.") + (license license:gpl3+)))) + (define-public linux-pam (package (name "linux-pam") From patchwork Thu May 1 13:42:36 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Felix Lechner X-Patchwork-Id: 42212 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id D352827BC49; Thu, 1 May 2025 14:44:24 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id AD71B27BC4A for ; Thu, 1 May 2025 14:44:22 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uAUD1-0007Q0-Qt; Thu, 01 May 2025 09:44:16 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1uAUCp-0007KM-Q2 for guix-patches@gnu.org; Thu, 01 May 2025 09:44:04 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1uAUCp-0002DA-2G; Thu, 01 May 2025 09:44:03 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=n18ziyKLmau3VOeoR1nnaB+UBbKcX91Hv5RGl2U9hAQ=; b=bhuck1LZgpMJSo12z+E4sSJNG4P9HRQ1pHYQtoomgvOKB2QwzYK1IjweyiLapsVCYPflMK5P8PL+8Qp9tlvEyHMqszjkLVTTODsMQxBlwu6SS/3lRraGFxKkMmO9DIJvt58ElcvfT72xZPqMjp8CguyZ+88jCpN0bprssu92pJu0gqgWiHW2tmivyUvY/H5Be2ugy/ZYt93RNuMjPHhhOzkoY14MLAevLy1oMVe/Ofu2mB0kcDGYzH6/Kg65WB7c6TJIorKMMbnE6v8AwOYeb2vtpbYsJ8UzMrYpf/dvvFH6iNjpGd6GON8izGiQo6y3ltbvwrCrzJu7MD0BaqFCXg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uAUCo-0001Lg-2P; Thu, 01 May 2025 09:44:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#72316] [PATCH v2 2/3] Add a guile-pam-module service. Resent-From: Felix Lechner Original-Sender: "Debbugs-submit" Resent-CC: gabriel@erlikon.ch, ludo@gnu.org, maxim.cournoyer@gmail.com, guix-patches@gnu.org Resent-Date: Thu, 01 May 2025 13:44:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72316 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 72316@debbugs.gnu.org Cc: Maxim Cournoyer , Ludovic =?utf-8?q?Court?= =?utf-8?q?=C3=A8s?= , Z572 , Florian Pelz , Felix Lechner , Matthew Trzcinski , Gabriel Wicki , Ludovic =?utf-8?q?Court=C3=A8s?= , Maxim Cournoyer X-Debbugs-Original-Xcc: Gabriel Wicki , Ludovic =?utf-8?q?Court=C3=A8s?= , Maxim Cournoyer Received: via spool by 72316-submit@debbugs.gnu.org id=B72316.17461069865064 (code B ref 72316); Thu, 01 May 2025 13:44:02 +0000 Received: (at 72316) by debbugs.gnu.org; 1 May 2025 13:43:06 +0000 Received: from localhost ([127.0.0.1]:49851 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uAUBt-0001JW-Nh for submit@debbugs.gnu.org; Thu, 01 May 2025 09:43:06 -0400 Received: from sail-ipv4.us-core.com ([208.82.101.137]:33450) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uAUBq-0001I8-8h for 72316@debbugs.gnu.org; Thu, 01 May 2025 09:43:03 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=simple/simple; s=2017; bh=CSG8A4aL5+qEagR 8kBnXJg9L659smKP4AlYG2eoUdAo=; h=references:in-reply-to:date:subject: cc:to:from; d=lease-up.com; b=AkzpUp5F1SZNdzJmLU34QDGJ9vWmpsV5KMFh9CkB cPurd0jCzO71TNkQyMcSVYiueo4f4mc5NQW9RkjwMQj99NGdikhFHWCflaZre2/LttEx7x qtG5tJayA6o7CZtgYmHGwm3AjDv/uKpSaswTpWRR+ynQA/0YujsejgMfrIdOA= Received: by sail-ipv4.us-core.com (OpenSMTPD) with ESMTPSA id b103aa7b (TLSv1.3:TLS_AES_256_GCM_SHA384:256:NO); Thu, 1 May 2025 13:43:01 +0000 (UTC) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id eb4d078c; Thu, 1 May 2025 13:43:00 +0000 (UTC) Date: Thu, 1 May 2025 06:42:36 -0700 Message-ID: X-Mailer: git-send-email 2.49.0 In-Reply-To: <878qnj80pt.fsf@iscas.ac.cn> References: <878qnj80pt.fsf@iscas.ac.cn> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-to: Felix Lechner X-ACL-Warn: , Felix Lechner via Guix-patches X-Patchwork-Original-From: Felix Lechner via Guix-patches via From: Felix Lechner Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches Change-Id: I1da0fe25f542cf9d8c22d26a7434f952585119e6 --- doc/guix.texi | 89 ++++++++++++++++++++++++++++++++++++ gnu/local.mk | 1 + gnu/services/pam.scm | 105 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 195 insertions(+) create mode 100644 gnu/services/pam.scm diff --git a/doc/guix.texi b/doc/guix.texi index 90d90b2e1eb..11480cb0ae5 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -412,6 +412,7 @@ Top * Telephony Services:: Telephony services. * File-Sharing Services:: File-sharing services. * Monitoring Services:: Monitoring services. +* Guile-PAM Services:: Guile-PAM services. * Kerberos Services:: Kerberos services. * LDAP Services:: LDAP services. * Web Services:: Web servers. @@ -19437,6 +19438,7 @@ Services * Telephony Services:: Telephony services. * File-Sharing Services:: File-sharing services. * Monitoring Services:: Monitoring services. +* Guile-PAM Services:: Guile-PAM services. * Kerberos Services:: Kerberos services. * LDAP Services:: LDAP services. * Web Services:: Web servers. @@ -33149,6 +33151,93 @@ Monitoring Services @end deftp +@c %end of fragment + +@node Guile-PAM Services +@subsection Guile-PAM Services +@cindex Guile-PAM + +The @code{(gnu services pam)} module provides services related to the +authentication mechanism @dfn{Guile-PAM}. + +Guile-PAM is a reimplementation in GNU Guile of the venerable Linux-PAM +authentication system. For details, please have a look at the Texinfo +manual in the @code{guile-pam} package. + +@defvar guile-pam-module-service-type +A service type for Guile-PAM modules. +@end defvar + +@noindent +Here is an example of its use: +@lisp +(define welcome-pamda-file + (scheme-file + "welcome-pamda-file" + #~(begin + (use-modules (ice-9 format)) + + (lambda (action handle flags options) + (case action + ;; authentication management + ((pam_sm_authenticate) + (format #t "In a working module, we would now identify you.~%")) + ((pam_sm_setcred) + (format #t "In a working module, we would now help you manage additional credentials.~%")) + ;; account management + ((pam_sm_acct_mgmt) + (format #t "In a working module, we would now confirm your access rights.~%")) + ;; password management + ((pam_sm_chauthtok) + (format #t "In a working module, we would now change your password.~%")) + ;; session management + ((pam_sm_open_session) + (format #t "In a working module, we would now open a session for you.~%")) + ((pam_sm_close_session) + (format #t "In a working module, we would now close your session.~%")) + (else + (format #t "In a working module, we would not know what to do about action '~s'.~%" + action))) + 'PAM_SUCCESS)))) + +(service guile-pam-module-service-type + (guile-pam-module-configuration + (rules "optional") + (module welcome-pamda-file) + (services '("login" + "greetd" + "su" + "slim" + "gdm-password" + "sddm")))) +@end lisp + +@c %start of fragment + +@deftp {Data Type} guile-pam-module-configuration +Available @code{guile-pam-module-configuration} fields are: + +@table @asis +@item @code{rules} (type: maybe-string) +Determines how the module's return value is evaluated. + +@item @code{module} (type: maybe-file-like) +A Guile-PAM pamda file or a classical PAM module. + +@item @code{services} (type: maybe-list-of-strings) +List of PAM service names for which to install the module. + +@item @code{guile-inputs} (type: maybe-list-of-packages) +Guile inputs available in the PAM module + +@item @code{foreign-library-path} (type: maybe-list-of-packages) +Search path for shared objects and libraries. + +@end table + +@end deftp + + @c %end of fragment @node Kerberos Services diff --git a/gnu/local.mk b/gnu/local.mk index f6f95bbf10b..3d3da58d659 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -764,6 +764,7 @@ GNU_SYSTEM_MODULES = \ %D%/services/networking.scm \ %D%/services/nix.scm \ %D%/services/nfs.scm \ + %D%/services/pam.scm \ %D%/services/pam-mount.scm \ %D%/services/power.scm \ %D%/services/science.scm \ diff --git a/gnu/services/pam.scm b/gnu/services/pam.scm new file mode 100644 index 00000000000..a242067e380 --- /dev/null +++ b/gnu/services/pam.scm @@ -0,0 +1,105 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2024 Felix Lechner +;;; +;;; 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 . + +(define-module (gnu services pam) + #:use-module (gnu packages guile) + #:use-module (gnu packages guile-xyz) + #:use-module (gnu packages linux) + #:use-module (gnu packages mes) + #:use-module (gnu services) + #:use-module (gnu services configuration) + #:use-module (gnu system pam) + #:use-module (guix gexp) + #:use-module (guix packages) + #:use-module (guix records) + #:use-module (guix utils) + #:use-module (srfi srfi-1) + #:export (guile-pam-module-configuration)) + +(define-maybe string) +(define-maybe list-of-strings) +(define-maybe file-like) + +(define-maybe string-or-file-like) +(define (string-or-file-like? val) + (or (string? val) (file-like? val))) + +(define-maybe list-of-packages) +(define (list-of-packages? val) + (and (list? val) (map package? val))) + +(define-configuration/no-serialization guile-pam-module-configuration + (rules + maybe-string + "Determines how the module's return value is evaluated.") + (module + maybe-file-like + "A Guile-PAM pamda file or a classical PAM module.") + (services + maybe-list-of-strings + "List of PAM service names for which to install the module.") + (guile-inputs + maybe-list-of-packages + "Guile inputs available in the PAM module") + (foreign-library-path + maybe-list-of-packages + "Search path for shared objects and libraries.") ) + +(define (guile-pam-module-service config) + "Return a list of for guile-pam-module for CONFIG." + (match-record + config (foreign-library-path + guile-inputs + module + rules + services) + (list + (pam-extension + (transformer + (lambda (pam) + (if (member (pam-service-name pam) services) + (let* ((new-entry + (pam-entry + (control rules) + (module module) + (guile-inputs (if (eq? %unset-value guile-inputs) + '() + guile-inputs)) + (foreign-library-path (if (eq? %unset-value foreign-library-path) + '() + foreign-library-path))))) + (pam-service + (inherit pam) + (auth (append (pam-service-auth pam) + (list new-entry))) + (account (append (pam-service-account pam) + (list new-entry))) + (session (append (pam-service-session pam) + (list new-entry))) + (password (append (pam-service-password pam) + (list new-entry))))) + pam))))))) + +(define-public guile-pam-module-service-type + (service-type + (name 'guile-pam-module) + (extensions (list (service-extension pam-root-service-type + guile-pam-module-service))) + (compose concatenate) + (default-value (guile-pam-module-configuration)) + (description "Load Guile code as part of Linux-PAM."))) From patchwork Thu May 1 13:42:37 2025 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Felix Lechner X-Patchwork-Id: 42213 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 167F127BC4B; Thu, 1 May 2025 14:44:38 +0100 (BST) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-6.4 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_DNSWL_BLOCKED, RCVD_IN_VALIDITY_CERTIFIED,RCVD_IN_VALIDITY_RPBL,RCVD_IN_VALIDITY_SAFE, SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 5A8E227BC49 for ; Thu, 1 May 2025 14:44:36 +0100 (BST) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1uAUD4-0007R0-MJ; Thu, 01 May 2025 09:44:18 -0400 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1uAUCp-0007KL-5Z for guix-patches@gnu.org; Thu, 01 May 2025 09:44:04 -0400 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1uAUCo-0002D9-Pt for guix-patches@gnu.org; Thu, 01 May 2025 09:44:02 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:References:In-Reply-To:Date:From:To:Subject; bh=Ba4+iQjcPLjkqtiwj16Vjpzz96Ino0TZeCfa1jDkX0U=; b=sGGVLT0zE88yujWeQw5HE++HW8RGrzF7cOUcUuDYt6PLFDAvRrztSGLKoxRi3sByVUidxDU8dtl+8t2r/skCM9ExX0NxdDL7NUAQ3LeKmAfV0Fmb4qTQxVsnqW72MvRpHoNlqPiYEbMsjDlNp3hh3TnC94NbS2SvfcLYkXP/NQgIVCK0/kIz8h3oHkctwzo+0YBmxkWhQOuiJO7659CbY+z1S45YpnWPG8tjnMH2Qv0sm3f1V35W3YN6X4RX04agV7E1y1/C4yuyNcmqyJ113iZ9Rsrgdn1TAli3O4KQ1sjTo1IgHdxKrGi3rQYySpu/O26GjtFoMt3hnUv39Lcbbg==; Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1uAUCo-0001Lo-Ia; Thu, 01 May 2025 09:44:02 -0400 X-Loop: help-debbugs@gnu.org Subject: [bug#72316] [PATCH v2 3/3] Switch to Guile-PAM. Resent-From: Felix Lechner Original-Sender: "Debbugs-submit" Resent-CC: liliana.prikler@gmail.com, maxim.cournoyer@gmail.com, noelopez@free.fr, vivien@planete-kraus.eu, guix-patches@gnu.org Resent-Date: Thu, 01 May 2025 13:44:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72316 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 72316@debbugs.gnu.org Cc: Maxim Cournoyer , Ludovic =?utf-8?q?Court?= =?utf-8?q?=C3=A8s?= , Z572 , Florian Pelz , Felix Lechner , Matthew Trzcinski , Liliana Marie Prikler , Maxim Cournoyer , =?utf-8?q?No=C3=A9?= Lopez , Vivien Kraus X-Debbugs-Original-Xcc: Liliana Marie Prikler , Maxim Cournoyer , =?utf-8?q?No=C3=A9?= Lopez , Vivien Kraus Received: via spool by 72316-submit@debbugs.gnu.org id=B72316.17461070215137 (code B ref 72316); Thu, 01 May 2025 13:44:02 +0000 Received: (at 72316) by debbugs.gnu.org; 1 May 2025 13:43:41 +0000 Received: from localhost ([127.0.0.1]:49856 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1uAUCF-0001KS-U7 for submit@debbugs.gnu.org; Thu, 01 May 2025 09:43:41 -0400 Received: from sail-ipv4.us-core.com ([208.82.101.137]:35942) by debbugs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.84_2) (envelope-from ) id 1uAUCB-0001K4-To for 72316@debbugs.gnu.org; Thu, 01 May 2025 09:43:27 -0400 DKIM-Signature: v=1; a=rsa-sha256; c=simple/simple; s=2017; bh=tkGJZZht6wiRAOk zcj8LiIq/GzTLChYSPCG5QzyuAWw=; h=references:in-reply-to:date:subject: cc:to:from; d=lease-up.com; b=CBnFFrTPl6mGFjVmg/mAeaJG7PrHGRwymIIf+mJD ln+GCBcdX+6Rdb/WugiUGPZu1m+JlwesA6d/jP1qSHya9/kNH/y77gCYzEaeBNetUYGYQ9 f4sNKBi8ixK21H4p7PSIw7Oe1Ii1eD5fCZg6MRYJZMDrdSu0fXVFnhmqAz1KI= Received: by sail-ipv4.us-core.com (OpenSMTPD) with ESMTPSA id b1894548 (TLSv1.3:TLS_AES_256_GCM_SHA384:256:NO); Thu, 1 May 2025 13:43:20 +0000 (UTC) Received: from localhost (localhost [local]) by localhost (OpenSMTPD) with ESMTPA id 605a020e; Thu, 1 May 2025 13:43:20 +0000 (UTC) Date: Thu, 1 May 2025 06:42:37 -0700 Message-ID: <3ce2c97a2c23ba3eb0a9ff4544e686048fc46174.1746104902.git.felix.lechner@lease-up.com> X-Mailer: git-send-email 2.49.0 In-Reply-To: <878qnj80pt.fsf@iscas.ac.cn> References: <878qnj80pt.fsf@iscas.ac.cn> MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-to: Felix Lechner X-ACL-Warn: , Felix Lechner via Guix-patches X-Patchwork-Original-From: Felix Lechner via Guix-patches via From: Felix Lechner Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches Change-Id: Ib691b41cdb152f508a4a8d1b12b2a20da8706fed --- gnu/services/authentication.scm | 9 +- gnu/services/base.scm | 16 +- gnu/services/desktop.scm | 14 +- gnu/services/kerberos.scm | 12 +- gnu/services/lightdm.scm | 69 ++++++-- gnu/services/pam-mount.scm | 5 +- gnu/services/sddm.scm | 91 +++++++--- gnu/services/xorg.scm | 17 +- gnu/system/pam.scm | 296 ++++++++++++++++++++++++++------ 9 files changed, 420 insertions(+), 109 deletions(-) diff --git a/gnu/services/authentication.scm b/gnu/services/authentication.scm index fbfef2d3d0a..88ccba6ada4 100644 --- a/gnu/services/authentication.scm +++ b/gnu/services/authentication.scm @@ -503,9 +503,6 @@ (define (nslcd-shepherd-service config) (define (pam-ldap-pam-service config) "Return a PAM service for LDAP authentication." - (define pam-ldap-module - (file-append (nslcd-configuration-nss-pam-ldapd config) - "/lib/security/pam_ldap.so")) (pam-extension (transformer (lambda (pam) @@ -514,7 +511,11 @@ (define (pam-ldap-pam-service config) (let ((sufficient (pam-entry (control "sufficient") - (module pam-ldap-module)))) + (module "pam_ldap.so") + (foreign-library-path + (list + (file-append (nslcd-configuration-nss-pam-ldapd config) + "/lib/security")))))) (pam-service (inherit pam) (auth (cons sufficient (pam-service-auth pam))) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 650121be8f1..6fb84ce01e1 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -61,8 +61,8 @@ (define-module (gnu services base) #:use-module (gnu packages admin) #:use-module ((gnu packages linux) #:select (alsa-utils btrfs-progs crda eudev - e2fsprogs f2fs-tools fuse gpm kbd lvm2 rng-tools - util-linux xfsprogs)) + e2fsprogs f2fs-tools fuse gpm kbd linux-pam + lvm2 rng-tools util-linux xfsprogs)) #:use-module (gnu packages bash) #:use-module ((gnu packages base) #:select (coreutils glibc glibc/hurd @@ -1731,7 +1731,10 @@ (define pam-limits-service-type (control "required") (module "pam_limits.so") (arguments - (list #~(string-append "conf=" #$limits-file)))))) + (list #~(string-append "conf=" #$limits-file))) + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (if (member (pam-service-name pam) '("login" "greetd" "su" "slim" "gdm-password" "sddm" "lightdm" "sudo" "sshd")) @@ -4032,8 +4035,11 @@ (define (greetd-pam-service config) (define optional-pam-mount (pam-entry (control "optional") - (module (file-append greetd-pam-mount "/lib/security/pam_mount.so")) - (arguments '("disable_interactive")))) + (module "pam_mount.so") + (arguments '("disable_interactive")) + (foreign-library-path + (list + (file-append greetd-pam-mount "/lib/security"))))) (list (unix-pam-service "greetd" diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm index a586746cc59..ca1078f9df6 100644 --- a/gnu/services/desktop.scm +++ b/gnu/services/desktop.scm @@ -1494,8 +1494,10 @@ (define (pam-extension-procedure config) (define pam-elogind (pam-entry (control "required") - (module (file-append (elogind-configuration-elogind config) - "/lib/security/pam_elogind.so")))) + (module "pam_elogind.so") + (foreign-library-path + (list + (file-append (elogind-configuration-elogind config) "/lib/security"))))) (list (pam-extension (transformer @@ -1712,9 +1714,11 @@ (define (pam-gnome-keyring config) (define (%pam-keyring-entry . arguments) (pam-entry (control "optional") - (module (file-append (gnome-keyring-package config) - "/lib/security/pam_gnome_keyring.so")) - (arguments arguments))) + (module ("pam_gnome_keyring.so")) + (arguments arguments) + (foreign-library-path + (list + (file-append (gnome-keyring-package config) "/lib/security"))))) (list (pam-extension diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm index a6f540a9b6a..d2d8988a837 100644 --- a/gnu/services/kerberos.scm +++ b/gnu/services/kerberos.scm @@ -431,18 +431,18 @@ (define (pam-krb5-pam-service config) (pam-extension (transformer (lambda (pam) - (define pam-krb5-module - (file-append (pam-krb5-configuration-pam-krb5 config) - "/lib/security/pam_krb5.so")) - (let ((pam-krb5-sufficient (pam-entry (control "sufficient") - (module pam-krb5-module) + (module "pam_krb5.so") (arguments (list (format #f "minimum_uid=~a" - (pam-krb5-configuration-minimum-uid config))))))) + (pam-krb5-configuration-minimum-uid config)))) + (foreign-library-path + (list + (file-append (pam-krb5-configuration-pam-krb5 config) + "/lib/security")))))) (pam-service (inherit pam) (auth (cons* pam-krb5-sufficient diff --git a/gnu/services/lightdm.scm b/gnu/services/lightdm.scm index b69cc21322a..6cca06b827a 100644 --- a/gnu/services/lightdm.scm +++ b/gnu/services/lightdm.scm @@ -24,6 +24,7 @@ (define-module (gnu services lightdm) #:use-module (gnu packages display-managers) #:use-module (gnu packages freedesktop) #:use-module (gnu packages gnome) + #:use-module ((gnu packages linux) #:select (linux-pam)) #:use-module (gnu packages vnc) #:use-module (gnu packages xorg) #:use-module (gnu services configuration) @@ -546,15 +547,35 @@ (define (lightdm-greeter-pam-service) (name "lightdm-greeter") (auth (list ;; Load environment from /etc/environment and ~/.pam_environment. - (pam-entry (control "required") (module "pam_env.so")) + (pam-entry (control "required") + (module "pam_env.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))) ;; Always let the greeter start without authentication. - (pam-entry (control "required") (module "pam_permit.so")))) + (pam-entry (control "required") + (module "pam_permit.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) ;; No action required for account management - (account (list (pam-entry (control "required") (module "pam_permit.so")))) + (account (list (pam-entry (control "required") + (module "pam_permit.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) ;; Prohibit changing password. - (password (list (pam-entry (control "required") (module "pam_deny.so")))) + (password (list (pam-entry (control "required") + (module "pam_deny.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) ;; Setup session. - (session (list (pam-entry (control "required") (module "pam_unix.so")))))) + (session (list (pam-entry (control "required") + (module "pam_unix.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))))) (define (lightdm-autologin-pam-service) "Return a PAM service for @command{lightdm-autologin}}." @@ -563,17 +584,41 @@ (define (lightdm-autologin-pam-service) (auth (list ;; Block login if user is globally disabled. - (pam-entry (control "required") (module "pam_nologin.so")) - (pam-entry (control "required") (module "pam_succeed_if.so") - (arguments (list "uid >= 1000"))) + (pam-entry (control "required") + (module "pam_nologin.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))) + (pam-entry (control "required") + (module "pam_succeed_if.so") + (arguments (list "uid >= 1000")) + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))) ;; Allow access without authentication. - (pam-entry (control "required") (module "pam_permit.so")))) + (pam-entry (control "required") + (module "pam_permit.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) ;; Stop autologin if account requires action. - (account (list (pam-entry (control "required") (module "pam_unix.so")))) + (account (list (pam-entry (control "required") + (module "pam_unix.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) ;; Prohibit changing password. - (password (list (pam-entry (control "required") (module "pam_deny.so")))) + (password (list (pam-entry (control "required") + (module "pam_deny.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) ;; Setup session. - (session (list (pam-entry (control "required") (module "pam_unix.so")))))) + (session (list (pam-entry (control "required") + (module "pam_unix.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))))) (define (lightdm-pam-services config) (list (lightdm-pam-service config) diff --git a/gnu/services/pam-mount.scm b/gnu/services/pam-mount.scm index b3a02e82e92..1eb5b44e315 100644 --- a/gnu/services/pam-mount.scm +++ b/gnu/services/pam-mount.scm @@ -94,7 +94,10 @@ (define (pam-mount-pam-service config) (define optional-pam-mount (pam-entry (control "optional") - (module (file-append pam-mount "/lib/security/pam_mount.so")))) + (module "pam_mount.so") + (foreign-library-path + (list + (file-append pam-mount "/lib/security"))))) (list (pam-extension (transformer diff --git a/gnu/services/sddm.scm b/gnu/services/sddm.scm index 92d64cc5993..cb2c5a9276d 100644 --- a/gnu/services/sddm.scm +++ b/gnu/services/sddm.scm @@ -24,6 +24,7 @@ (define-module (gnu services sddm) #:use-module (gnu packages admin) #:use-module (gnu packages display-managers) #:use-module (gnu packages freedesktop) + #:use-module ((gnu packages linux) #:select (linux-pam)) #:use-module (gnu packages xorg) #:use-module (gnu services) #:use-module (gnu services shepherd) @@ -206,40 +207,61 @@ (define (sddm-pam-service config) (list (pam-entry (control "requisite") - (module "pam_nologin.so")) + (module "pam_nologin.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))) (pam-entry (control "required") - (module "pam_env.so")) + (module "pam_env.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))) (pam-entry (control "required") (module "pam_succeed_if.so") (arguments (list (string-append "uid >= " (number->string (sddm-configuration-minimum-uid config))) - "quiet"))) + "quiet")) + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))) ;; should be factored out into system-auth (pam-entry (control "required") - (module "pam_unix.so")))) + (module "pam_unix.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (account (list ;; should be factored out into system-account (pam-entry (control "required") - (module "pam_unix.so")))) + (module "pam_unix.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (password (list ;; should be factored out into system-password (pam-entry (control "required") (module "pam_unix.so") - (arguments (list "sha512" "shadow" "try_first_pass"))))) + (arguments (list "sha512" "shadow" "try_first_pass")) + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (session (list ;; lfs has a required pam_limits.so ;; should be factored out into system-session (pam-entry (control "required") - (module "pam_unix.so")))))) + (module "pam_unix.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))))) (define (sddm-greeter-pam-service) "Return a PAM service for @command{sddm-greeter}." @@ -250,29 +272,44 @@ (define (sddm-greeter-pam-service) ;; Load environment from /etc/environment and ~/.pam_environment (pam-entry (control "required") - (module "pam_env.so")) + (module "pam_env.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))) ;; Always let the greeter start without authentication (pam-entry (control "required") - (module "pam_permit.so")))) + (module "pam_permit.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (account (list ;; No action required for account management (pam-entry (control "required") - (module "pam_permit.so")))) + (module "pam_permit.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (password (list ;; Can't change password (pam-entry (control "required") - (module "pam_deny.so")))) + (module "pam_deny.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (session (list ;; Setup session (pam-entry (control "required") - (module "pam_unix.so")))))) + (module "pam_unix.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))))) (define (sddm-autologin-pam-service config) "Return a PAM service for @command{sddm-autologin}" @@ -282,31 +319,37 @@ (define (sddm-autologin-pam-service config) (list (pam-entry (control "requisite") - (module "pam_nologin.so")) + (module "pam_nologin.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))) (pam-entry (control "required") (module "pam_succeed_if.so") (arguments (list (string-append "uid >= " (number->string (sddm-configuration-minimum-uid config))) - "quiet"))) + "quiet")) + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))) (pam-entry (control "required") - (module "pam_permit.so")))) + (module "pam_permit.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (account - (list - (pam-entry - (control "include") - (module "sddm")))) + (pam-service-account (sddm-pam-service config))) (password (list (pam-entry (control "required") - (module "pam_deny.so")))) + (module "pam_deny.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (session - (list - (pam-entry - (control "include") - (module "sddm")))))) + (pam-service-session (sddm-pam-service config))))) (define (sddm-pam-services config) (list (sddm-pam-service config) diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm index bef05b9bb9b..21f9924d166 100644 --- a/gnu/services/xorg.scm +++ b/gnu/services/xorg.scm @@ -1236,16 +1236,25 @@ (define (gdm-pam-service config) #:login-uid? #t)) (auth (list (pam-entry (control "optional") - (module (file-append (gdm-configuration-gdm config) - "/lib/security/pam_gdm.so"))) + (module "pam_gdm.so") + (foreign-library-path + (list + (file-append (gdm-configuration-gdm config) + "/lib/security/")))) (pam-entry (control "sufficient") - (module "pam_permit.so"))))) + (module "pam_permit.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security"))))))) (pam-service (inherit (unix-pam-service "gdm-launch-environment")) (auth (list (pam-entry (control "required") - (module "pam_permit.so"))))) + (module "pam_permit.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security"))))))) (unix-pam-service "gdm-password" #:login-uid? #t #:allow-empty-passwords? diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm index 07b84b04efe..08dc4693297 100644 --- a/gnu/system/pam.scm +++ b/gnu/system/pam.scm @@ -32,7 +32,9 @@ (define-module (gnu system pam) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) #:use-module ((guix utils) #:select (%current-system)) + #:use-module (gnu packages guile) #:use-module (gnu packages linux) + #:use-module (gnu packages mes) #:export (pam-service pam-service? pam-service-name @@ -46,6 +48,8 @@ (define-module (gnu system pam) pam-entry-control pam-entry-module pam-entry-arguments + pam-entry-guile-inputs + pam-entry-foreign-library-path pam-limits-entry pam-limits-entry? @@ -95,10 +99,16 @@ (define-record-type* pam-service (define-record-type* pam-entry make-pam-entry pam-entry? - (control pam-entry-control) ; string + (control pam-entry-control) ; string, symbol or g-expression (module pam-entry-module) ; file name (arguments pam-entry-arguments ; list of string-valued g-expressions - (default '()))) + (default '())) + (guile-inputs pam-entry-guile-inputs ; list of package variables + (default '())) + (foreign-library-path pam-entry-foreign-library-path ; list of file-like folders + ;; courtesy for historical usage + (default (list + (file-append linux-pam "/lib/security"))))) ;; PAM limits entries are used by the pam_limits PAM module to set or override ;; limits on system resources for user sessions. The format is specified @@ -153,35 +163,80 @@ (define (pam-limits-entry->string entry) (number->string value)))) " ")))) -(define (pam-service->configuration service) +(define (pam-service->configuration service shared-object environment-file pamda-file) "Return the derivation building the configuration file for SERVICE, to be dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE." - (define (entry->gexp type entry) - (match entry - (($ control module (arguments ...)) - #~(format #t "~a ~a ~a ~a~%" - #$type #$control #$module - (string-join (list #$@arguments)))))) - - (match service - (($ name account auth password session) - (define builder - #~(begin - (with-output-to-file #$output - (lambda () - #$@(append (map (cut entry->gexp "account" <>) account) - (map (cut entry->gexp "auth" <>) auth) - (map (cut entry->gexp "password" <>) password) - (map (cut entry->gexp "session" <>) session)) - #t)))) - - (computed-file name builder)))) - -(define (pam-services->directory services) + (mixed-text-file (pam-service-name service) + "account required " shared-object " " environment-file " " pamda-file "\n" + "auth required " shared-object " " environment-file " " pamda-file "\n" + "password required " shared-object " " environment-file " " pamda-file "\n" + "session required " shared-object " " environment-file " " pamda-file "\n")) + +(define (intersperse a xs) + (if (null? xs) + '() + [cons (car xs) + (if (null? (cdr xs)) + (cdr xs) + (cons a (intersperse a (cdr xs))))])) + +;; should include locale, but keeping effects of pam_env.so +(define* (make-environment-file #:key + (guile-auto-compile? #f) + (guile-extensions-path '()) + (guile-install-locale? #f) + (guile-jit-log-level 0) + (guile-jit-pause-when-stopping? #f) + (guile-jit-stop-after -1) + (guile-jit-threshold 1000) + (guile-load-compiled-path '()) + (guile-load-path '()) + (guile-warn-deprecated "yes") + (ld-library-path '()) + (ltdl-library-path '())) + (let* ((lines `(("GUILE_AUTO_COMPILE=" ,(if guile-auto-compile? "1" "0")) + ("GUILE_EXTENSIONS_PATH=" ,@(intersperse ":" guile-extensions-path)) + ("GUILE_INSTALL_LOCALE=" ,(if guile-install-locale? "1" "0")) + ("GUILE_JIT_LOG=" ,(number->string guile-jit-log-level)) + ("GUILE_JIT_PAUSE_WHEN_STOPPING=" ,(if guile-jit-pause-when-stopping? "1" "0")) + ("GUILE_JIT_STOP_AFTER=" ,(number->string guile-jit-stop-after)) + ("GUILE_JIT_THRESHOLD=" ,(number->string guile-jit-threshold)) + ("GUILE_LOAD_COMPILED_PATH=" ,@(intersperse ":" guile-load-compiled-path)) + ("GUILE_LOAD_PATH=" ,@(intersperse ":" guile-load-path)) + ("GUILE_WARN_DEPRECATED=" ,guile-warn-deprecated) + ("LD_LIBRARY_PATH=" ,@(intersperse ":" ld-library-path)) + ("LTDL_LIBRARY_PATH=" ,@(intersperse ":" ltdl-library-path)))) + (terminated (map (lambda (line) + (append line '("\0"))) + lines)) + (flattened (fold (lambda (right left) + (append left right)) + '() + terminated))) + (apply mixed-text-file "guile-pam-environment" flattened))) + +(define (pam-services->directory shared-object + guile-inputs + foreign-library-path + folder + services) "Return the derivation to build the configuration directory to be used as /etc/pam.d for SERVICES." - (let ((names (map pam-service-name services)) - (files (map pam-service->configuration services))) + (let* ((names (map pam-service-name services)) + (load-path (map (lambda (package) + (file-append package "/share/guile/site/3.0")) + guile-inputs)) + (load-compiled-path (map (lambda (package) + (file-append package "/lib/guile/3.0/site-ccache")) + guile-inputs)) + (environment-file (make-environment-file #:guile-extensions-path foreign-library-path + #:ld-library-path foreign-library-path + #:guile-load-path load-path + #:guile-load-compiled-path load-compiled-path)) + (pamda-file (make-pam-stack folder services)) + (files (map (cut pam-service->configuration <> + shared-object environment-file pamda-file) + services))) (define builder #~(begin (use-modules (ice-9 match) @@ -198,14 +253,17 @@ (define (pam-services->directory services) ;; instead. See . (delete-duplicates '#$(zip names files))))) - (computed-file "pam.d" builder))) + (computed-file folder builder))) (define %pam-other-services ;; The "other" PAM configuration, which denies everything (see ;; .) (let ((deny (pam-entry (control "required") - (module "pam_deny.so")))) + (module "pam_deny.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (pam-service (name "other") (account (list deny)) @@ -216,12 +274,18 @@ (define %pam-other-services (define unix-pam-service (let ((unix (pam-entry (control "required") - (module "pam_unix.so"))) + (module "pam_unix.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security"))))) (env (pam-entry ; to honor /etc/environment. (control "required") - (module "pam_env.so")))) + (module "pam_env.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (lambda* (name #:key allow-empty-passwords? allow-root? motd - login-uid? gnupg?) + login-uid? gnupg?) "Return a standard Unix-style PAM service for NAME. When ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords. When ALLOW-ROOT? is true, allow root to run the command without authentication. When MOTD is @@ -237,40 +301,61 @@ (define unix-pam-service (auth (append (if allow-root? (list (pam-entry (control "sufficient") - (module "pam_rootok.so"))) + (module "pam_rootok.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security"))))) '()) (list (if allow-empty-passwords? (pam-entry (control "required") (module "pam_unix.so") - (arguments '("nullok"))) + (arguments '("nullok")) + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))) unix)) (if gnupg? (list (pam-entry (control "required") - (module (file-append pam-gnupg "/lib/security/pam_gnupg.so")))) + (module "pam_gnupg.so") + (foreign-library-path + (list + (file-append pam-gnupg "/lib/security"))))) '()))) (password (list (pam-entry (control "required") (module "pam_unix.so") ;; Store SHA-512 encrypted passwords in /etc/shadow. - (arguments '("sha512" "shadow"))))) + (arguments '("sha512" "shadow")) + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (session `(,@(if motd (list (pam-entry (control "optional") (module "pam_motd.so") (arguments - (list #~(string-append "motd=" #$motd))))) + (list #~(string-append "motd=" #$motd))) + (foreign-library-path + (list + (file-append linux-pam "/lib/security"))))) '()) ,@(if login-uid? (list (pam-entry ;to fill in /proc/self/loginuid (control "required") - (module "pam_loginuid.so"))) + (module "pam_loginuid.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security"))))) '()) ,@(if gnupg? (list (pam-entry (control "required") - (module (file-append pam-gnupg "/lib/security/pam_gnupg.so")))) + (module "pam_gnupg.so") + (foreign-library-path + (list + (file-append pam-gnupg "/lib/security"))))) '()) ,env ,unix)))))) @@ -279,13 +364,19 @@ (define (rootok-pam-service command) authenticate to run COMMAND." (let ((unix (pam-entry (control "required") - (module "pam_unix.so")))) + (module "pam_unix.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (pam-service (name command) (account (list unix)) (auth (list (pam-entry (control "sufficient") - (module "pam_rootok.so")))) + (module "pam_rootok.so") + (foreign-library-path + (list + (file-append linux-pam "/lib/security")))))) (password (list unix)) (session (list unix))))) @@ -377,21 +468,114 @@ (define-record-type* (services pam-configuration-services) ;list of procedures -> (transformers pam-configuration-transformers) + ;; file-like shared module + (shared-object pam-configuration-shared-object) + ;; list of package variables + (guile-inputs pam-configuration-guile-inputs) + ;; list of file-like folders + (foreign-library-path pam-configuration-foreign-library-path) ;list of symbols (shepherd-requirements pam-configuration-shepherd-requirements)) +(define (make-pam-stack folder services) + (define* (entry->gate entry + #:key + only-actions + only-services) + (match entry + (($ control module (options ...)) + ;; adapted from (pam legacy configuration) + (cond + ((string=? "include" control) + (error "PAM include not implemented; send list of instead" + control module options entry)) + ((string=? "substack" control) + ;; this probably differs a little bit from Linux-PAM + #~(gate required (stack-pamda + (configuration-file->gates #$folder #$module + #:only-actions '#$only-actions + #:only-services '#$only-services)) + #:only-actions '#$only-actions + #:only-services '#$only-services)) + (else + #~(gate (control-string->plan #$control) + (shared-object-or-pamda #$module) + #:options (list #$@options) + #:only-actions '#$only-actions + #:only-services '#$only-services)))))) + + (define (service->gates service) + (match service + (($ name account auth password session) + (append (map (cut entry->gate <> + #:only-actions '(pam_sm_acct_mgmt) + #:only-services (list name)) + account) + (map (cut entry->gate <> + #:only-actions '(pam_sm_authenticate + pam_sm_setcred) + #:only-services (list name)) + auth) + (map (cut entry->gate <> + #:only-actions '(pam_sm_chauthtok) + #:only-services (list name)) + password) + (map (cut entry->gate <> + #:only-actions '(pam_sm_open_session + pam_sm_close_session) + #:only-services (list name)) + session))))) + + (let* ((gates (append-map service->gates services))) + (scheme-file + "guile-pam-stack.scm" + #~(begin + (use-modules (pam stack) + (pam legacy configuration) + (pam legacy module) + (pam legacy stack)) + (stack-pamda (list #$@gates)))))) + (define (/etc-entry config) "Return the /etc/pam.d entry corresponding to CONFIG." + (define (service->pam-entries service) + (match service + (($ name account auth password session) + (append account auth password session)))) (match config - (($ services transformers shepherd-requirements) - (let ((services (map (apply compose identity transformers) - services))) - `(("pam.d" ,(pam-services->directory services))))))) + (($ services + transformers + shared-object + guile-inputs + foreign-library-path + shepherd-requirements) + (let* ((services (map (apply compose identity transformers) + services)) + (all-entries (append-map service->pam-entries + services)) + (combined-inputs (delete-duplicates + (append guile-inputs + (append-map pam-entry-guile-inputs + all-entries)))) + (combined-library-path (delete-duplicates + (append foreign-library-path + (append-map pam-entry-foreign-library-path + all-entries))))) + `(("pam.d" ,(pam-services->directory shared-object + combined-inputs + combined-library-path + "pam.d" + services))))))) (define (pam-shepherd-service config) "Return the PAM synchronization shepherd service corresponding to CONFIG." (match config - (($ services transformers shepherd-requirements) + (($ services + transformers + shared-object + guile-inputs + foreign-library-path + shepherd-requirements) (list (shepherd-service (documentation "Synchronization point for services that need to be started for PAM to work.") @@ -420,6 +604,9 @@ (define (extend-configuration initial extensions) services)) (transformers (append (pam-configuration-transformers initial) (map pam-extension-transformer pam-extensions))) + (shared-object (pam-configuration-shared-object initial)) + (guile-inputs (pam-configuration-guile-inputs initial)) + (foreign-library-path (pam-configuration-foreign-library-path initial)) (shepherd-requirements (append (pam-configuration-shepherd-requirements initial) (append-map pam-extension-shepherd-requirements pam-extensions)))))) @@ -445,8 +632,18 @@ (define pam-root-service-type such as @command{login} or @command{sshd}, and specifies for instance how the program may authenticate users or what it should do when opening a new session."))) - -(define* (pam-root-service base #:key (transformers '()) (shepherd-requirements '())) +(define* (pam-root-service base + #:key + (transformers '()) + (shared-object + (file-append guile-pam "/lib/security/pam_guile.so")) + (guile-inputs + (list guile-3.0 + guile-pam ;for (pam) and (ffi pam) + nyacc-2.01)) ;for (nyacc foreign cdata) + (foreign-library-path + (list (file-append linux-pam "/lib"))) ;for libpam.so + (shepherd-requirements '())) "The \"root\" PAM service, which collects instance and turns them into a /etc/pam.d directory, including the listed in BASE. TRANSFORM is a procedure that takes a and returns a @@ -455,6 +652,9 @@ (define* (pam-root-service base #:key (transformers '()) (shepherd-requirements (service pam-root-service-type (pam-configuration (services base) (transformers transformers) + (shared-object shared-object) + (guile-inputs guile-inputs) + (foreign-library-path foreign-library-path) (shepherd-requirements shepherd-requirements))))