From mboxrd@z Thu Jan 1 00:00:00 1970 From: John Darrington Subject: [PATCH] gnu: Add Kerberos client service. Date: Tue, 22 Nov 2016 18:52:17 +0100 Message-ID: <1479837137-12251-1-git-send-email-jmd@gnu.org> References: <87ziktyzs8.fsf@gnu.org> Return-path: Received: from eggs.gnu.org ([2001:4830:134:3::10]:34707) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1c9FFI-00047R-Vu for guix-devel@gnu.org; Tue, 22 Nov 2016 12:52:46 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1c9FFD-0001s5-NE for guix-devel@gnu.org; Tue, 22 Nov 2016 12:52:41 -0500 In-Reply-To: <87ziktyzs8.fsf@gnu.org> List-Id: "Development of GNU Guix and the GNU System distribution." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-devel-bounces+gcggd-guix-devel=m.gmane.org@gnu.org Sender: "Guix-devel" To: guix-devel@gnu.org Cc: John Darrington 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(-) 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 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 make-pam-krb5-configuration @@ -65,3 +487,5 @@ (list (service-extension pam-root-service-type pam-krb5-pam-services))))) + +;; LocalWords: Guix -- 2.1.4