summaryrefslogtreecommitdiff
path: root/gnu/packages/linux.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-09-11 00:22:45 +0200
committerLudovic Courtès <ludo@gnu.org>2013-09-11 01:07:50 +0200
commitc84d0eca053cd524294ad10c1f49a877902932c4 (patch)
treeeb022879d5c4df5ba037d55ad3cddb2ac152925a /gnu/packages/linux.scm
parentcfbf916045c180c8f77f90e9c910012f18447dc9 (diff)
gnu: linux-pam: Add declarative PAM service interface.
* gnu/packages/linux.scm (<pam-service>, <pam-entry>): New record types. (pam-service->configuration, pam-services->directory, unix-pam-service): New procedures. (%pam-other-services): New variable.
Diffstat (limited to 'gnu/packages/linux.scm')
-rw-r--r--gnu/packages/linux.scm128
1 files changed, 127 insertions, 1 deletions
diff --git a/gnu/packages/linux.scm b/gnu/packages/linux.scm
index b5ed92e198..a479d791b6 100644
--- a/gnu/packages/linux.scm
+++ b/gnu/packages/linux.scm
@@ -32,7 +32,18 @@
#:use-module (gnu packages algebra)
#:use-module (guix packages)
#:use-module (guix download)
- #:use-module (guix build-system gnu))
+ #:use-module (guix build-system gnu)
+ #:use-module (guix store)
+ #:use-module (guix derivations)
+ #:use-module (guix records)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-26)
+ #:use-module (ice-9 match)
+ #:export (pam-service
+ pam-entry
+ pam-services->directory
+ %pam-other-services
+ unix-pam-service))
(define-public (system->linux-architecture arch)
"Return the Linux architecture name for ARCH, a Guix system name such as
@@ -214,6 +225,11 @@
(license gpl2)
(home-page "http://www.gnu.org/software/linux-libre/"))))
+
+;;;
+;;; Pluggable authentication modules (PAM).
+;;;
+
(define-public linux-pam
(package
(name "linux-pam")
@@ -255,6 +271,116 @@ be used through the PAM API to perform tasks, like authenticating a user
at login. Local and dynamic reconfiguration are its key features")
(license bsd-3)))
+;; PAM services (see
+;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-file.html>.)
+(define-record-type* <pam-service> pam-service
+ make-pam-service
+ pam-service?
+ (name pam-service-name) ; string
+
+ ;; The four "management groups".
+ (account pam-service-account ; list of <pam-entry>
+ (default '()))
+ (auth pam-service-auth
+ (default '()))
+ (password pam-service-password
+ (default '()))
+ (session pam-service-session
+ (default '())))
+
+(define-record-type* <pam-entry> pam-entry
+ make-pam-entry
+ pam-entry?
+ (control pam-entry-control) ; string
+ (module pam-entry-module) ; file name
+ (arguments pam-entry-arguments ; list of strings
+ (default '())))
+
+(define (pam-service->configuration service)
+ "Return the configuration string for SERVICE, to be dumped in
+/etc/pam.d/NAME, where NAME is the name of SERVICE."
+ (define (entry->string type entry)
+ (match entry
+ (($ <pam-entry> control module (arguments ...))
+ (string-append type " "
+ control " " module " "
+ (string-join arguments)
+ "\n"))))
+
+ (match service
+ (($ <pam-service> name account auth password session)
+ (string-concatenate
+ (append (map (cut entry->string "account" <>) account)
+ (map (cut entry->string "auth" <>) auth)
+ (map (cut entry->string "password" <>) password)
+ (map (cut entry->string "session" <>) session))))))
+
+(define (pam-services->directory store 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 (match-lambda
+ ((and service ($ <pam-service> name))
+ (let ((config (pam-service->configuration service)))
+ (add-text-to-store store
+ (string-append name ".pam")
+ config '()))))
+ services)))
+ (define builder
+ '(begin
+ (use-modules (ice-9 match))
+
+ (let ((out (assoc-ref %outputs "out")))
+ (mkdir out)
+ (for-each (match-lambda
+ ((name . file)
+ (symlink file (string-append out "/" name))))
+ %build-inputs)
+ #t)))
+
+ (build-expression->derivation store "pam.d" (%current-system)
+ builder
+ (zip names files))))
+
+(define %pam-other-services
+ ;; The "other" PAM configuration, which denies everything (see
+ ;; <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.)
+ (let ((deny (pam-entry
+ (control "required")
+ (module "pam_deny.so"))))
+ (pam-service
+ (name "other")
+ (account (list deny))
+ (auth (list deny))
+ (password (list deny))
+ (session (list deny)))))
+
+(define unix-pam-service
+ (let ((unix (pam-entry
+ (control "required")
+ (module "pam_unix.so"))))
+ (lambda* (name #:key allow-empty-passwords?)
+ "Return a standard Unix-style PAM service for NAME. When
+ALLOW-EMPTY-PASSWORDS? is true, allow empty passwords."
+ ;; See <http://www.linux-pam.org/Linux-PAM-html/sag-configuration-example.html>.
+ (let ((name* name))
+ (pam-service
+ (name name*)
+ (account (list unix))
+ (auth (list (if allow-empty-passwords?
+ (pam-entry
+ (control "required")
+ (module "pam_unix.so")
+ (arguments '("nullok")))
+ unix)))
+ (password (list unix))
+ (session (list unix)))))))
+
+
+;;;
+;;; Miscellaneous.
+;;;
+
(define-public psmisc
(package
(name "psmisc")