gnu/services/kerberos.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu services kerberos)
  20   #:use-module (gnu services)
  21   #:use-module (gnu services configuration)
  22   #:use-module (gnu system pam)
  23   #:use-module (guix gexp)
  24   #:use-module (guix records)
  25   #:use-module (srfi srfi-1)
  26   #:use-module (srfi srfi-34)
  27   #:use-module (srfi srfi-35)
  28   #:use-module (ice-9 match)
  29   #:export (pam-krb5-configuration
  30             pam-krb5-configuration?
  31             pam-krb5-service-type
  32
  33             krb5-realm
  34             krb5-realm?
  35
  36             krb5-configuration
  37             krb5-configuration?
  38             krb5-service-type))
  39
  40 \f
  41
  42 ;; TODO Use %unset-value and the define-maybe infrastructure.
  43 (define unset-field (list 'unset-field))
  44
  45 (define (predicate/unset pred)
  46   (lambda (x) (or (eq? x unset-field) (pred x))))
  47
  48 (define string/unset? (predicate/unset string?))
  49 (define boolean/unset? (predicate/unset boolean?))
  50 (define integer/unset? (predicate/unset integer?))
  51
  52 (define (uglify-field-name field-name)
  53   "Return FIELD-NAME with all instances of '-' replaced by '_' and any
  54 trailing '?' removed."
  55   (let ((str (symbol->string field-name)))
  56     (string-join (string-split (if (string-suffix? "?" str)
  57                                    (substring str 0 (1- (string-length str)))
  58                                    str)
  59                                #\-)
  60                  "_")))
  61
  62 (define (serialize-field* field-name val)
  63   (format #t "~a = ~a\n" (uglify-field-name field-name) val))
  64
  65 (define (serialize-string/unset field-name val)
  66   (unless (eq? val unset-field)
  67       (serialize-field* field-name val)))
  68
  69 (define (serialize-integer/unset field-name val)
  70   (unless (eq? val unset-field)
  71       (serialize-field* field-name val)))
  72
  73 (define (serialize-boolean/unset field-name val)
  74   (unless (eq? val unset-field)
  75       (serialize-field* field-name
  76                         (if val "true" "false"))))
  77
  78
  79 ;; An end-point is an address such as "192.168.0.1"
  80 ;; or an address port pair ("foobar.example.com" . 109)
  81 (define (end-point? val)
  82   (match val
  83     ((? string?) #t)
  84     (((? string?) . (? integer?)) #t)
  85     (_ #f)))
  86
  87 (define (serialize-end-point field-name val)
  88   (serialize-field* field-name
  89                     (match val
  90                       ((host . port)
  91                        ;; The [] are needed in the case of IPv6 addresses
  92                        (format #f "[~a]:~a" host port))
  93                       (host
  94                        (format #f "~a" host)))))
  95
  96 (define (serialize-space-separated-string-list/unset field-name val)
  97   (unless (eq? val unset-field)
  98       (serialize-field* field-name (string-join val " "))))
  99
 100 (define (space-separated-string-list? val)
 101   (and (list? val)
 102        (and-map (lambda (x)
 103                   (and (string? x) (not (string-index x #\space))))
 104                 val)))
 105
 106 (define space-separated-string-list/unset?
 107   (predicate/unset space-separated-string-list?))
 108
 109 (define comma-separated-integer-list/unset?
 110   (predicate/unset (lambda (val)
 111                      (and (list? val)
 112                           (and-map (lambda (x) (integer? x))
 113                                    val)))))
 114
 115 (define (serialize-comma-separated-integer-list/unset field-name val)
 116   (unless (eq? val unset-field)
 117       (serialize-field* field-name
 118                        (string-drop ; Drop the leading comma
 119                         (fold
 120                          (lambda (i prev)
 121                            (string-append prev "," (number->string i)))
 122                          "" val) 1))))
 123
 124 (define file-name? (predicate/unset
 125                     (lambda (val)
 126                       (string-prefix? "/" val))))
 127
 128 (define (serialize-field field-name val)
 129   (format #t "~a ~a\n" (uglify-field-name field-name) val))
 130
 131 (define (serialize-string field-name val)
 132   (serialize-field field-name val))
 133
 134 (define (serialize-file-name field-name val)
 135   (unless (eq? val unset-field)
 136     (serialize-string field-name val)))
 137
 138 (define (serialize-space-separated-string-list field-name val)
 139   (serialize-field field-name (string-join val " ")))
 140
 141 (define (non-negative-integer? val)
 142   (and (exact-integer? val) (not (negative? val))))
 143
 144 (define (serialize-non-negative-integer/unset field-name val)
 145   (unless (eq? val unset-field)
 146     (serialize-field* field-name val)))
 147
 148 (define (free-form-fields? val)
 149   (match val
 150     (() #t)
 151     ((((? symbol?) . (? string)) . val) (free-form-fields? val))
 152     (_ #f)))
 153
 154 (define (serialize-free-form-fields field-name val)
 155   (for-each (match-lambda ((k . v) (serialize-field* k v))) val))
 156
 157 (define non-negative-integer/unset? (predicate/unset non-negative-integer?))
 158
 159 (define (realm-list? val)
 160   (and (list? val)
 161        (and-map (lambda (x) (krb5-realm? x)) val)))
 162
 163 (define (serialize-realm-list field-name val)
 164   (format #t "\n[~a]\n" field-name)
 165   (for-each (lambda (realm)
 166               (format #t "\n~a = {\n" (krb5-realm-name realm))
 167               (for-each (lambda (field)
 168                           (unless (eq? 'name (configuration-field-name field))
 169                             ((configuration-field-serializer field)
 170                              (configuration-field-name field)
 171                              ((configuration-field-getter field)
 172                               realm)))) krb5-realm-fields)
 173
 174               (format #t "}\n")) val))
 175
 176 \f
 177
 178 ;; For a more detailed explanation of these fields see man 5 krb5.conf
 179 (define-configuration krb5-realm
 180   (name
 181    (string/unset unset-field)
 182    "The name of the realm.")
 183
 184   (kdc
 185    (end-point unset-field)
 186    "The host and port on which the realm's Key Distribution Server listens.")
 187
 188   (admin-server
 189    (string/unset unset-field)
 190    "The Host running the administration server for the realm.")
 191
 192   (master-kdc
 193    (string/unset unset-field)
 194    "If an attempt to get credentials fails because of an invalid password,
 195 the client software will attempt to contact the master KDC.")
 196
 197   (kpasswd-server
 198    (string/unset unset-field)
 199    "The server where password changes are performed.")
 200
 201   (auth-to-local
 202    (free-form-fields '())
 203    "Rules to map between principals and local users.")
 204
 205   (auth-to-local-names
 206    (free-form-fields '())
 207    "Explicit mappings between principal names and local user names.")
 208
 209   (http-anchors
 210    (free-form-fields '())
 211    "Useful only when http proxy is used to access KDC or KPASSWD.")
 212
 213   ;; The following are useful only for working with V4 services
 214   (default-domain
 215     (string/unset unset-field)
 216     "The domain used to expand host names when translating Kerberos 4 service
 217 principals to Kerberos 5 principals")
 218
 219   (v4-instance-convert
 220    (free-form-fields '())
 221    "Exceptions to the default-domain mapping rule.")
 222
 223   (v4-realm
 224    (string/unset unset-field)
 225    "Used  when the V4 realm name and the V5 realm name are not the same, but
 226 still share the same principal names and passwords"))
 227
 228
 229
 230 ;; For a more detailed explanation of these fields see man 5 krb5.conf
 231 (define-configuration krb5-configuration
 232   (allow-weak-crypto?
 233    (boolean/unset unset-field)
 234    "If true, permits access to services which only offer weak encryption.")
 235
 236   (ap-req-checksum-type
 237    (non-negative-integer/unset unset-field)
 238    "The type of the AP-REQ checksum.")
 239
 240   (canonicalize?
 241    (boolean/unset unset-field)
 242    "Should principals in initial ticket requests be canonicalized?")
 243
 244   (ccache-type
 245    (non-negative-integer/unset unset-field)
 246    "The format of the credential cache type.")
 247
 248   (clockskew
 249    (non-negative-integer/unset unset-field)
 250    "Maximum allowable clock skew in seconds (default 300).")
 251
 252   (default-ccache-name
 253     (file-name unset-field)
 254     "The name of the default credential cache.")
 255
 256   (default-client-keytab-name
 257     (file-name unset-field)
 258     "The name of the default keytab for client credentials.")
 259
 260   (default-keytab-name
 261     (file-name unset-field)
 262     "The name of the default keytab file.")
 263
 264   (default-realm
 265     (string/unset unset-field)
 266     "The realm to be accessed if not explicitly specified by clients.")
 267
 268   (default-tgs-enctypes
 269     (free-form-fields '())
 270     "Session key encryption types when making TGS-REQ requests.")
 271
 272   (default-tkt-enctypes
 273     (free-form-fields '())
 274     "Session key encryption types when making AS-REQ requests.")
 275
 276   (dns-canonicalize-hostname?
 277    (boolean/unset  unset-field)
 278    "Whether name lookups will be used to canonicalize host names for use in
 279 service principal names.")
 280
 281   (dns-lookup-kdc?
 282    (boolean/unset unset-field)
 283  "Should DNS SRV records should be used to locate the KDCs and other servers
 284 not appearing in the realm specification")
 285
 286   (err-fmt
 287    (string/unset unset-field)
 288    "Custom error message formatting. If not #f error messages will be formatted
 289 by substituting a normal error message for %M and an error code for %C in the
 290 value.")
 291
 292   (forwardable?
 293    (boolean/unset unset-field)
 294    "Should initial tickets be forwardable by default?")
 295
 296   (ignore-acceptor-hostname?
 297    (boolean/unset unset-field)
 298    "When accepting GSSAPI or krb5 security contexts for host-based service
 299 principals, ignore any hostname passed by the calling application, and allow
 300 clients to authenticate to any service principal in the keytab matching the
 301 service name and realm name.")
 302
 303   (k5login-authoritative?
 304    (boolean/unset unset-field)
 305    "If this flag is true, principals must be listed in a local user's k5login
 306 file to be granted login access, if a ~/.k5login file exists.")
 307
 308   (k5login-directory
 309    (string/unset unset-field)
 310    "If not #f, the library will look for a local user's @file{k5login} file
 311 within the named directory (instead of the user's home directory), with a
 312 file name corresponding to the local user name.")
 313
 314   (kcm-mach-service
 315    (string/unset unset-field)
 316    "The name of the bootstrap service used to contact the KCM daemon for the
 317 KCM credential cache type.")
 318
 319   (kcm-socket
 320    (file-name unset-field)
 321  "Path to the Unix domain socket used to access the KCM daemon for the KCM
 322 credential cache type.")
 323
 324   (kdc-default-options
 325    (non-negative-integer/unset unset-field)
 326    "Default KDC options (logored for multiple values) when requesting initial
 327 tickets.")
 328
 329   (kdc-timesync
 330    (non-negative-integer/unset unset-field)
 331    "Attempt to compensate for clock skew between the KDC and client.")
 332
 333   (kdc-req-checksum-type
 334    (non-negative-integer/unset unset-field)
 335    "The type of checksum to use for the KDC requests. Relevant only for DES
 336 keys")
 337
 338   (noaddresses?
 339    (boolean/unset unset-field)
 340    "If true, initial ticket requests will not be made with address restrictions.
 341 This enables their use across NATs.")
 342
 343   (permitted-enctypes
 344    (space-separated-string-list/unset unset-field)
 345    "All encryption types that are permitted for use in session key encryption.")
 346
 347   (plugin-base-dir
 348    (file-name unset-field)
 349    "The directory where krb5 plugins are located.")
 350
 351   (preferred-preauth-types
 352    (comma-separated-integer-list/unset unset-field)
 353    "The preferred pre-authentication types which the client will attempt before
 354 others.")
 355
 356   (proxiable?
 357    (boolean/unset unset-field)
 358    "Should initial tickets be proxiable by default?")
 359
 360   (rdns?
 361    (boolean/unset unset-field)
 362    "Should reverse DNS lookup be used in addition to forward name lookup to
 363 canonicalize host names for use in service principal names.")
 364
 365   (realm-try-domains
 366    (integer/unset unset-field)
 367    "Should a host's domain components should be used to determine the Kerberos
 368 realm of the host.")
 369
 370   (renew-lifetime
 371    (non-negative-integer/unset unset-field)
 372    "The default renewable lifetime for initial ticket requests.")
 373
 374   (safe-checksum-type
 375    (non-negative-integer/unset unset-field)
 376    "The type of checksum to use for the KRB-SAFE requests.")
 377
 378   (ticket-lifetime
 379    (non-negative-integer/unset unset-field)
 380    "The default lifetime for initial ticket requests.")
 381
 382   (udp-preference-limit
 383    (non-negative-integer/unset unset-field)
 384    "When sending messages to the KDC, the library will try using TCP
 385 before UDP if the size of the message greater than this limit.")
 386
 387   (verify-ap-rereq-nofail?
 388    (boolean/unset unset-field)
 389  "If true, then attempts to verify initial credentials will fail if the client
 390 machine does not have a keytab.")
 391
 392   (realms
 393    (realm-list '())
 394    "The list of realms which clients may access."))
 395
 396
 397 (define (krb5-configuration-file config)
 398   "Create a Kerberos 5 configuration file based on CONFIG"
 399   (mixed-text-file "krb5.conf"
 400                    "[libdefaults]\n\n"
 401                    (with-output-to-string
 402                      (lambda ()
 403                        (serialize-configuration config
 404                                                 krb5-configuration-fields)))))
 405
 406 (define (krb5-etc-service config)
 407   (list `("krb5.conf" ,(krb5-configuration-file config))))
 408
 409
 410 (define krb5-service-type
 411   (service-type (name 'krb5)
 412                 (extensions
 413                  (list (service-extension etc-service-type
 414                                           krb5-etc-service)))
 415                 (description "Programs using a Kerberos client library
 416 normally expect a configuration file in @file{/etc/krb5.conf}.  This service
 417 generates such a file.  It does not cause any daemon to be started.")))
 418
 419 \f
 420
 421 (define-record-type* <pam-krb5-configuration>
 422   pam-krb5-configuration  make-pam-krb5-configuration
 423   pam-krb5-configuration?
 424   (pam-krb5               pam-krb5-configuration-pam-krb5
 425                           (default pam-krb5))
 426   (minimum-uid            pam-krb5-configuration-minimum-uid
 427                           (default 1000)))
 428
 429 (define (pam-krb5-pam-service config)
 430   "Return a PAM service for Kerberos authentication."
 431   (lambda (pam)
 432     (define pam-krb5-module
 433       #~(string-append #$(pam-krb5-configuration-pam-krb5 config)
 434                        "/lib/security/pam_krb5.so"))
 435
 436     (let ((pam-krb5-sufficient
 437            (pam-entry
 438             (control "sufficient")
 439             (module pam-krb5-module)
 440             (arguments
 441              (list
 442               (format #f "minimum_uid=~a"
 443                       (pam-krb5-configuration-minimum-uid config)))))))
 444       (pam-service
 445        (inherit pam)
 446        (auth (cons* pam-krb5-sufficient
 447                     (pam-service-auth pam)))
 448        (session (cons* pam-krb5-sufficient
 449                        (pam-service-session pam)))
 450        (account (cons* pam-krb5-sufficient
 451                        (pam-service-account pam)))))))
 452
 453 (define (pam-krb5-pam-services config)
 454   (list (pam-krb5-pam-service config)))
 455
 456 (define pam-krb5-service-type
 457   (service-type (name 'pam-krb5)
 458                 (extensions
 459                  (list
 460                   (service-extension pam-root-service-type
 461                                      pam-krb5-pam-services)))
 462                 (description "The @code{pam-krb5} service allows for login
 463 authentication and password management via Kerberos.  You will need this
 464 service if you want PAM-enabled applications to authenticate users using
 465 Kerberos.")))