From: John Darrington <jmd@gnu.org>
To: guix-devel@gnu.org
Cc: John Darrington <jmd@gnu.org>
Subject: [PATCH] gnu: Add Kerberos client service.
Date: Tue, 22 Nov 2016 18:52:17 +0100 [thread overview]
Message-ID: <1479837137-12251-1-git-send-email-jmd@gnu.org> (raw)
In-Reply-To: <87ziktyzs8.fsf@gnu.org>
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))
+
+\f
+
+(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))
+
+\f
+
+;; 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)))))
+
+
+\f
(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
--
2.1.4
next prev parent reply other threads:[~2016-11-22 17:52 UTC|newest]
Thread overview: 14+ messages / expand[flat|nested] mbox.gz Atom feed top
2016-11-09 19:58 [PATCH] gnu: Add kerberos service John Darrington
2016-11-18 15:23 ` John Darrington
2016-11-18 22:51 ` Ludovic Courtès
2016-11-19 6:57 ` John Darrington
2016-11-21 8:59 ` Ludovic Courtès
2016-11-22 17:52 ` John Darrington [this message]
2016-11-23 22:01 ` [PATCH] gnu: Add Kerberos client service Ludovic Courtès
2016-11-29 18:39 ` John Darrington
2016-11-29 18:39 ` John Darrington
2016-11-30 13:09 ` Ludovic Courtès
2016-11-30 13:44 ` John Darrington
2016-11-30 13:52 ` Andy Wingo
2016-12-03 12:27 ` John Darrington
2016-12-03 15:13 ` Ludovic Courtès
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=1479837137-12251-1-git-send-email-jmd@gnu.org \
--to=jmd@gnu.org \
--cc=guix-devel@gnu.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).