diff mbox

gnu: Add Kerberos client service.

Message ID 1479837137-12251-1-git-send-email-jmd@gnu.org
State New
Headers show

Commit Message

John Darrington Nov. 22, 2016, 5:52 p.m. UTC
I think this patch addresses most of your concerns.








* doc/guix.texi: New subsubheading: Krb5 Service
* gnu/services/kerberos.scm: New variable: krb5-service-type.
---
 doc/guix.texi             |  87 ++++++++++
 gnu/services/kerberos.scm | 426 +++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 512 insertions(+), 1 deletion(-)

Comments

Ludovic Courtès Nov. 23, 2016, 10:01 p.m. UTC | #1
Hi!

John Darrington <jmd@gnu.org> skribis:

> * doc/guix.texi: New subsubheading: Krb5 Service
> * gnu/services/kerberos.scm: New variable: krb5-service-type.

Please see ‘git log’ on how to introduce new sections and variables.

> +@subsubheading Krb5 Service
> +
> +The krb5 service provides the configuration for Kerberos clients, using
> +the MIT implementation of the Kerberos protocol version@tie{}5.

Maybe add: “ (the @code{mit-krb5} package).”

Also it would be good to add one or two sentences of context, like:

  Programs using the client library of @code{mit-krb5} expect such
  configuration files in @file{/etc/something} and read them to set up
  their Kerberos frobbing thingie.  System administrators typically
  define the appropriate configuration based on the network's Kerberos
  foobar.

Well, something like that.  :-)

> +@defvr {Scheme Variable} krb5-service-type
> +A service type for Kerberos 5 clients.

s/Kerberos 5/@code{mit-krb5}/

> +@lisp
> +(service krb5-service-type (krb5-configuration
> +				(default-realm "EXAMPLE.COM")

Please move the ‘krb5-configuration’ to the next line where it will be
aligned below ‘krb5-service-type’.  This will ensure correct PDF/PS/DVI
output as well as below-80 Info lines.

> +@item @code{allow-weak-crypto?} (default: @code{#f})
> +If this flag is #t then services which only offer encryption algorithms

@code{#t}

> +(define-syntax define-configuration
> +  (lambda (stx)
> +    (define (id ctx part . parts)

Nack!  We already have two copies of that one, we won’t add a third
one.  :-)

Fortunately, Julien submitted a patch to factorize it, so hopefully you
can use the factorize ‘define-configuration’ in a day or two.

> +;; For a more detailed explanation of these fields see man 5 krb5.conf
> +(define-configuration krb5-realm
> +  (name
> +   (string #f)
> +   "The name of the realm.")

Really cool.

> +;;  LocalWords:  Guix

Maybe we can avoid that, but no big deal.

So OK with changes along these lines when Julien’s factorization has
landed.

Thank you!

Ludo’.
John Darrington Nov. 29, 2016, 6:39 p.m. UTC | #2
I'm sending this for another round of review, since I had to change a
few things in gnu/services/configuraiton.scm
diff mbox

Patch

diff --git a/doc/guix.texi b/doc/guix.texi
index 7381c2c..668dc45 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11374,6 +11374,93 @@  could instantiate a dovecot service like this:
 The @code{(gnu services Kerberos)} module provides services relating to
 the authentication protocol @dfn{Kerberos}.
 
+@subsubheading Krb5 Service
+
+The krb5 service provides the configuration for Kerberos clients, using
+the MIT implementation of the Kerberos protocol version@tie{}5.
+
+@defvr {Scheme Variable} krb5-service-type
+A service type for Kerberos 5 clients.
+@end defvr
+
+@noindent
+Here is an example of its use:
+@lisp
+(service krb5-service-type (krb5-configuration
+				(default-realm "EXAMPLE.COM")
+				(allow-weak-crypto? #t)
+				(realms (list
+					 (krb5-realm
+					  (name "EXAMPLE.COM")
+					  (admin-server "groucho.example.com")
+					  (kdc "karl.example.com"))
+					 (krb5-realm
+					  (name "ARGRX.EDU")
+					  (admin-server "kerb-admin.argrx.edu")
+					  (kdc "keys.argrx.edu"))))))
+@end lisp
+
+@noindent
+This example provides a Kerberos@tie{}5 client configuration which:
+@itemize
+@item Recognizes two realms, @i{viz:} ``EXAMPLE.COM'' and ``ARGRX.EDU'', both
+of which have distinct administration servers and key distribution centers;
+@item Will default to the realm ``EXAMPLE.COM'' if the realm is not explicitly
+specified by clients;
+@item Accepts services which only support encryption types known to be weak.
+@end itemize
+
+The @code{krb5-realm} and @code{krb5-configuration} types have many fields.
+Only the most commonly used ones are described here.
+For a full list, and more detailed explanation of each, see the MIT
+@uref{http://web.mit.edu/kerberos/krb5-devel/doc/admin/conf_files/krb5_conf.html,,krb5.conf}
+documentation.
+
+
+@deftp {Data Type} krb5-realm
+@cindex realm, kerberos
+@table @asis
+@item @code{name}
+This field is a string identifying the name of the realm.
+A common convention is to use the fully qualified DNS name of your organization,
+converted to upper case.
+
+@item @code{admin-server}
+This field is a string identifying the host where the administration server is
+running.
+
+@item @code{kdc}
+This field is a string identifying the key distribution center
+for the realm.
+@end table
+@end deftp
+
+
+@deftp {Data Type} krb5-configuration
+
+@table @asis
+@item @code{allow-weak-crypto?} (default: @code{#f})
+If this flag is #t then services which only offer encryption algorithms
+known to be weak will be accepted.
+
+@item @code{default-realm} (default: @code{#f})
+This field should be a string identifying the default Kerberos
+realm for the client.
+You should set this field to the name of your Kerberos realm.
+If this value is @code{#f}
+then a realm must be specified with every Kerberos principal when invoking programs
+such as @command{kinit}.
+
+@item @code{realms}
+This should be a non-empty list of @code{krb5-realm} objects, which clients may
+access.
+Normally, one of them will have a @code{name} field matching the @code{default-realm}
+field.
+@end table
+@end deftp
+
+
+
 @subsubheading PAM krb5 Service
 @cindex pam-krb5
 
diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm
index 144c71b..85a7c6a 100644
--- a/gnu/services/kerberos.scm
+++ b/gnu/services/kerberos.scm
@@ -22,9 +22,431 @@ 
   #:use-module (gnu system pam)
   #:use-module (guix gexp)
   #:use-module (guix records)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-34)
+  #:use-module (srfi srfi-35)
+  #:use-module (ice-9 match)
   #:export (pam-krb5-configuration
             pam-krb5-configuration?
-            pam-krb5-service-type))
+            pam-krb5-service-type
+
+            krb5-realm
+            krb5-realm?
+
+            krb5-configuration
+            krb5-configuration?
+            krb5-service-type))
+
+
+
+(define-record-type* <configuration-field>
+  configuration-field make-configuration-field configuration-field?
+  (name configuration-field-name)
+  (type configuration-field-type)
+  (getter configuration-field-getter)
+  (predicate configuration-field-predicate)
+  (serializer configuration-field-serializer)
+  (default-value-thunk configuration-field-default-value-thunk)
+  (documentation configuration-field-documentation))
+
+(define-syntax define-configuration
+  (lambda (stx)
+    (define (id ctx part . parts)
+      (let ((part (syntax->datum part)))
+        (datum->syntax
+         ctx
+         (match parts
+           (() part)
+           (parts (symbol-append part
+                                 (syntax->datum (apply id ctx parts))))))))
+    (syntax-case stx ()
+      ((_ stem (field (field-type def) doc) ...)
+       (with-syntax (((field-getter ...)
+                      (map (lambda (field)
+                             (id #'stem #'stem #'- field))
+                           #'(field ...)))
+                     ((field-predicate ...)
+                      (map (lambda (type)
+                             (id #'stem type #'?))
+                           #'(field-type ...)))
+                     ((field-serializer ...)
+                      (map (lambda (type)
+                             (id #'stem #'serialize- type))
+                           #'(field-type ...))))
+         #`(begin
+             (define-record-type* #,(id #'stem #'< #'stem #'>)
+               stem #,(id #'stem #'make- #'stem) #,(id #'stem #'stem #'?)
+               (field field-getter (default def))
+               ...)
+             (define #,(id #'stem #'stem #'-fields)
+               (list (configuration-field
+                      (name 'field)
+                      (type 'field-type)
+                      (getter field-getter)
+                      (predicate field-predicate)
+                      (serializer field-serializer)
+                      (default-value-thunk (lambda () def))
+                      (documentation doc))
+                     ...))))))))
+
+(define (serialize-configuration config fields)
+  (for-each (lambda (field)
+              ((configuration-field-serializer field)
+               (configuration-field-name field)
+               ((configuration-field-getter field) config)))
+            fields))
+
+(define (uglify-field-name field-name)
+  (let ((str (symbol->string field-name)))
+    (string-join (string-split (if (string-suffix? "?" str)
+                                   (substring str 0 (1- (string-length str)))
+                                   str)
+                               #\-)
+                 "_")))
+
+(define (serialize-field field-name val)
+  (format #t "~a = ~a\n" (uglify-field-name field-name) val))
+
+(define (serialize-string field-name val)
+  (if val
+      (serialize-field field-name val) ""))
+
+;; An end-point is an address such as "192.168.0.1"
+;; or an address port pair ("foo.example.com" . 109)
+(define (end-point? val)
+  (or (string? val)
+      (and (pair? val)
+           (string? (car val))
+           (integer? (cdr val)))))
+
+(define (serialize-end-point field-name val)
+  (serialize-field field-name
+                   (if (string? val)
+                       ;; The [] are needed in the case of IPv6 addresses
+                       (format #f "[~a]" val)
+                       (format #f "[~a]:~a" (car val) (cdr val)))))
+
+
+(define (space-separated-string-list? val)
+  (and (list? val)
+       (and-map (lambda (x)
+                  (and (string? x) (not (string-index x #\space))))
+                val)))
+(define (serialize-space-separated-string-list field-name val)
+  (if val
+      (serialize-field field-name (string-join val " "))))
+
+(define (comma-separated-string-list? val)
+  (and (list? val)
+       (and-map (lambda (x)
+                  (and (string? x) (not (string-index x #\,))))
+                val)))
+
+(define (serialize-comma-separated-string-list field-name val)
+  (serialize-field field-name (string-join val ",")))
+
+(define (comma-separated-integer-list? val)
+  (and (list? val)
+       (and-map (lambda (x) (integer? x))
+                val)))
+
+(define (serialize-comma-separated-integer-list field-name val)
+  (if val
+      (serialize-field field-name
+                       (string-drop ; Drop the leading comma
+                        (fold
+                         (lambda (i prev)
+                           (string-append prev "," (number->string i)))
+                         "" val) 1))))
+
+(define (file-name? val)
+  (and (string? val)
+       (string-prefix? "/" val)))
+
+(define (serialize-file-name field-name val)
+  (serialize-string field-name val))
+
+
+(define (serialize-boolean field-name val)
+  (serialize-string field-name (if val "true" "false")))
+
+(define (non-negative-integer? val)
+  (and (exact-integer? val) (not (negative? val))))
+
+(define (serialize-non-negative-integer field-name val)
+  (if val
+      (serialize-field field-name val)))
+
+(define (serialize-integer field-name val)
+  (if val
+      (serialize-field field-name val)))
+
+(define (free-form-fields? val)
+  (match val
+    (() #t)
+    ((((? symbol?) . (? string)) . val) (free-form-fields? val))
+    (_ #f)))
+
+(define (serialize-free-form-fields field-name val)
+  (for-each (match-lambda ((k . v) (serialize-field k v))) val))
+
+(define (realm-list? val)
+  (and (list? val)
+       (and-map (lambda (x) (krb5-realm? x)) val)))
+
+(define (serialize-realm-list field-name val)
+  (format #t "\n[~a]\n" field-name)
+  (for-each (lambda (realm)
+              (format #t "\n~a = {\n" (krb5-realm-name realm))
+              (for-each (lambda (field)
+                          (unless (eq? 'name (configuration-field-name field))
+                            ((configuration-field-serializer field)
+                             (configuration-field-name field)
+                             ((configuration-field-getter field)
+                              realm)))) krb5-realm-fields)
+
+              (format #t "}\n")) val))
+
+
+
+;; For a more detailed explanation of these fields see man 5 krb5.conf
+(define-configuration krb5-realm
+  (name
+   (string #f)
+   "The name of the realm.")
+
+  (kdc
+   (end-point #f)
+   "The host and port on which the realm's Key Distribution Server listens.")
+
+  (admin-server
+   (string #f)
+   "The Host running the administration server for the realm.")
+
+  (master-kdc
+   (string #f)
+   "If an attempt to get credentials fails because of an invalid password, 
+the client software will attempt to contact the master KDC.")
+
+  (kpasswd-server
+   (string #f)
+   "The server where password changes are performed.")
+
+  (auth-to-local
+   (free-form-fields '())
+   "Rules to map between principals and local users.")
+
+  (auth-to-local-names
+   (free-form-fields '())
+   "Explicit mappings between principal names and local user names.")
+
+  (http-anchors
+   (free-form-fields '())
+   "Useful only when http proxy is used to access KDC or KPASSWD.")
+
+  ;; The following are useful only for working with V4 services
+  (default-domain
+    (string #f)
+    "The domain used to expand host names when translating Kerberos 4 service
+principals to Kerberos 5 principals")
+
+  (v4-instance-convert
+   (free-form-fields '())
+   "Exceptions to the default-domain mapping rule.")
+
+  (v4-realm
+   (string #f)
+   "Used  when the V4 realm name and the V5 realm name are not the same, but
+still share the same principal names and passwords"))
+
+
+
+;; For a more detailed explanation of these fields see man 5 krb5.conf
+(define-configuration krb5-configuration
+  (allow-weak-crypto?
+   (boolean #f)
+   "If true, permits access to services which only offer weak encryption.")
+
+  (ap-req-checksum-type
+   (non-negative-integer #f)
+   "The type of the AP-REQ checksum.")
+
+  (canonicalize?
+   (boolean #f)
+   "Should principals in initial ticket requests be canonicalized?")
+
+  (ccache-type
+   (non-negative-integer #f)
+   "The format of the credential cache type.")
+
+  (clockskew
+   (non-negative-integer #f)
+   "Maximum allowable clock skew in seconds (default 300).")
+
+  (default-ccache-name
+    (file-name #f)
+    "The name of the default credential cache.")
+
+  (default-client-keytab-name
+    (file-name #f)
+    "The name of the default keytab for client credentials.")
+
+  (default-keytab-name
+    (file-name #f)
+    "The name of the default keytab file.")
+
+  (default-realm
+    (string #f)
+    "The realm to be accessed if not explicitly specified by clients.")
+
+  (default-tgs-enctypes
+    (free-form-fields '())
+    "Session key encryption types when making TGS-REQ requests.")
+
+  (default-tkt-enctypes
+    (free-form-fields '())
+    "Session key encryption types when making AS-REQ requests.")
+
+  (dns-canonicalize-hostname?
+   (boolean #t)
+   "Whether name lookups will be used to canonicalize host names for use in service
+principal names.")
+
+  (dns-lookup-kdc?
+   (boolean #f)
+ "Should DNS SRV records should be used to locate the KDCs and other servers 
+not appearing in the realm specification")
+
+  (err-fmt
+   (string #f)
+   "Custom error message formatting. If not #f error messages will be formatted 
+by substituting a normal error message for %M and an error code for %C in the value.")
+
+  (forwardable?
+   (boolean #f)
+   "Should initial tickets be forwardable by default?")
+
+  (ignore-acceptor-hostname?
+   (boolean #f)
+   "When accepting GSSAPI or krb5 security contexts for host-based service 
+principals, ignore any hostname passed by the calling application, and allow 
+clients to authenticate to any service principal in the keytab matching the 
+service name and realm name.")
+
+  (k5login-authoritative?
+   (boolean #t)
+   "If this flag is true, principals must be listed in a local user's k5login
+file to be granted login access, if a ~/.k5login file exists.")
+
+  (k5login-directory
+   (string #f)
+   "If not #f, the library will look for a local user's @file{k5login} file 
+within the named directory (instead of the user's home directory), with a 
+file name corresponding to the local user name.")
+
+  (kcm-mach-service
+   (string #f)
+   "The name of the bootstrap service used to contact the KCM daemon for the KCM 
+credential cache type.")
+
+  (kcm-socket
+   (file-name #f)
+ "Path to the Unix domain socket used to access the KCM daemon for the KCM 
+credential cache type.")
+
+  (kdc-default-options
+   (non-negative-integer #f)
+   "Default KDC options (logored for multiple values) when requesting initial 
+tickets.")
+
+  (kdc-timesync
+   (non-negative-integer #f)
+   "Attempt to compensate for clock skew between the KDC and client.")
+
+  (kdc-req-checksum-type
+   (non-negative-integer #f)
+   "The type of checksum to use for the KDC requests. Relevant only for DES keys")
+
+  (noaddresses?
+   (boolean #t)
+   "If true, initial ticket requests will not be made with address restrictions.
+This enables their use across NATs.")
+
+  (permitted-enctypes
+   (space-separated-string-list #f)
+   "All encryption types that are permitted for use in session key encryption.")
+
+  (plugin-base-dir
+   (file-name #f)
+   "The directory where krb5 plugins are located.")
+
+  (preferred-preauth-types
+   (comma-separated-integer-list #f)
+   "The preferred pre-authentication types which the client will attempt before 
+others.")
+
+  (proxiable?
+   (boolean #f)
+   "Should initial tickets be proxiable by default?")
+
+  (rdns?
+   (boolean #t)
+   "Should reverse DNS lookup be used in addition to forward name lookup to 
+canonicalize host names for use in service principal names.")
+
+  (realm-try-domains
+   (integer #f)
+   "Should a host's domain components should be used to determine the Kerberos 
+realm of the host.")
+
+  (renew-lifetime
+   (non-negative-integer #f)
+   "The default renewable lifetime for initial ticket requests.")
+
+  (safe-checksum-type
+   (non-negative-integer #f)
+   "The type of checksum to use for the KRB-SAFE requests.")
+
+  (ticket-lifetime
+   (non-negative-integer #f)
+   "The default lifetime for initial ticket requests.")
+
+  (udp-preference-limit
+   (non-negative-integer #f)
+   "When sending messages to the KDC, the library will try using TCP
+before UDP if the size of the message greater than this limit.")
+
+  (verify-ap-req-nofail?
+   (boolean #f)
+ "If true, then attempts to verify initial credentials will fail if the client
+machine does not have a keytab.")
+
+  (realms
+   (realm-list '())
+   "The list of realms which clients may access."))
+
+
+(define (krb5-configuration-file config)
+  "Create a Kerberos 5 configuration file based on CONFIG"
+  (mixed-text-file "krb5.conf"
+                   "[libdefaults]\n\n"
+                   (with-output-to-string
+                     (lambda ()
+                       (serialize-configuration config
+                                                krb5-configuration-fields)))))
+
+(define (krb5-etc-service config)
+  (list `("krb5.conf" ,(krb5-configuration-file config))))
+
+
+(define krb5-service-type
+  (service-type (name 'krb5)
+                (extensions
+                 (list (service-extension etc-service-type
+                                          krb5-etc-service)))))
+
+
+
 
 (define-record-type* <pam-krb5-configuration>
   pam-krb5-configuration  make-pam-krb5-configuration
@@ -65,3 +487,5 @@ 
                  (list
                   (service-extension pam-root-service-type
                                      pam-krb5-pam-services)))))
+
+;;  LocalWords:  Guix