services: Add pam-limits-service.

* gnu/system/pam.scm (<pam-limits-entry>): New record type.
(pam-limits-entry, pam-limits-entry->string): New procedures.
* gnu/services/base.scm (pam-limits-service-type): New variable.
(pam-limits-service): New procedure.
* doc/guix.texi (Base Services): Document it.

2 files changed, 104 insertions, 0 deletions

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index c9c2594533..805ba7d12c 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -5,6 +5,7 @@
 ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com>
 ;;; Copyright © 2016 Leo Famulari <leo@famulari.name>
 ;;; Copyright © 2016 David Craven <david@craven.ch>
+;;; Copyright © 2016 Ricardo Wurmus <rekado@elephly.net>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -100,6 +101,8 @@
             urandom-seed-service
             rngd-service-type
             rngd-service
+            pam-limits-service-type
+            pam-limits-service
 
             %base-services))
 
@@ -924,6 +927,46 @@ settings.
 information on the configuration file syntax."
   (service syslog-service-type config-file))
 
+(define pam-limits-service-type
+  (let ((security-limits
+         ;; Create /etc/security containing the provided "limits.conf" file.
+         (lambda (limits-file)
+           `(("security"
+              ,(computed-file
+                "security"
+                #~(begin
+                    (mkdir #$output)
+                    (stat #$limits-file)
+                    (symlink #$limits-file
+                             (string-append #$output "/limits.conf"))))))))
+        (pam-extension
+         (lambda (pam)
+           (let ((pam-limits (pam-entry
+                              (control "required")
+                              (module "pam_limits.so")
+                              (arguments '("conf=/etc/security/limits.conf")))))
+             (if (member (pam-service-name pam)
+                         '("login" "su" "slim"))
+                 (pam-service
+                  (inherit pam)
+                  (session (cons pam-limits
+                                 (pam-service-session pam))))
+                 pam)))))
+    (service-type
+     (name 'limits)
+     (extensions
+      (list (service-extension etc-service-type security-limits)
+            (service-extension pam-root-service-type
+                               (lambda _ (list pam-extension))))))))
+
+(define* (pam-limits-service #:optional (limits '()))
+  "Return a service that makes selected programs respect the list of
+pam-limits-entry specified in LIMITS via pam_limits.so."
+  (service pam-limits-service-type
+           (plain-file "limits.conf"
+                       (string-join (map pam-limits-entry->string limits)
+                                    "\n"))))
+
 
 ;;;
 ;;; Guix services.
diff --git a/gnu/system/pam.scm b/gnu/system/pam.scm
index 743039daf6..cd7a3427ed 100644
--- a/gnu/system/pam.scm
+++ b/gnu/system/pam.scm
@@ -23,6 +23,7 @@
   #:use-module (gnu services)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module ((guix utils) #:select (%current-system))
@@ -38,6 +39,13 @@
             pam-entry-module
             pam-entry-arguments
 
+            pam-limits-entry
+            pam-limits-entry-domain
+            pam-limits-entry-type
+            pam-limits-entry-item
+            pam-limits-entry-value
+            pam-limits-entry->string
+
             pam-services->directory
             unix-pam-service
             base-pam-services
@@ -76,6 +84,59 @@
   (arguments  pam-entry-arguments        ; list of string-valued g-expressions
               (default '())))
 
+;; 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
+;; here: http://linux-pam.org/Linux-PAM-html/sag-pam_limits.html
+(define-record-type <pam-limits-entry>
+  (make-pam-limits-entry domain type item value)
+  pam-limits-entry?
+  (domain     pam-limits-entry-domain)   ; string
+  (type       pam-limits-entry-type)     ; symbol
+  (item       pam-limits-entry-item)     ; symbol
+  (value      pam-limits-entry-value))   ; symbol or number
+
+(define (pam-limits-entry domain type item value)
+  "Construct a pam-limits-entry ensuring that the provided values are valid."
+  (define (valid? value)
+    (case item
+      ((priority) (number? value))
+      ((nice)     (and (number? value)
+                       (>= value -20)
+                       (<= value 19)))
+      (else       (or (and (number? value)
+                           (>= value -1))
+                      (member value '(unlimited infinity))))))
+  (define items
+    (list 'core      'data       'fsize
+          'memlock   'nofile     'rss
+          'stack     'cpu        'nproc
+          'as        'maxlogins  'maxsyslogins
+          'priority  'locks      'sigpending
+          'msgqueue  'nice       'rtprio))
+  (when (not (member type '(hard soft both)))
+    (error "invalid limit type" type))
+  (when (not (member item items))
+    (error "invalid limit item" item))
+  (when (not (valid? value))
+    (error "invalid limit value" value))
+  (make-pam-limits-entry domain type item value))
+
+(define (pam-limits-entry->string entry)
+  "Convert a pam-limits-entry record to a string."
+  (match entry
+    (($ <pam-limits-entry> domain type item value)
+     (string-join (list domain
+                        (if (eq? type 'both)
+                            "-"
+                            (symbol->string type))
+                        (symbol->string item)
+                        (cond
+                         ((symbol? value)
+                          (symbol->string value))
+                         (else
+                          (number->string value))))
+                  "	"))))
+
 (define (pam-service->configuration service)
   "Return the derivation building the configuration file for SERVICE, to be
 dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."