[PATCH] gnu: Add kerberos service.

[PATCH] gnu: Add kerberos service.

[John Darrington]

* gnu/services/kerberos.scm (krb5-realm, krb5-configuration,
krb5-service-type): New variables.
---
 gnu/services/kerberos.scm | 230 +++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 229 insertions(+), 1 deletion(-)

diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm
index 144c71b..2147dd8 100644
--- a/gnu/services/kerberos.scm
+++ b/gnu/services/kerberos.scm
@@ -22,9 +22,237 @@
   #:use-module (gnu system pam)
   #:use-module (guix gexp)
   #:use-module (guix records)
+  #:use-module (srfi srfi-1)
   #: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* <krb5-realm>
+  krb5-realm      make-krb5-realm
+  krb5-realm?
+  (name                krb5-realm-name)
+
+  (admin-server        krb5-realm-admin-server)
+  (kdc                 krb5-realm-kdc)
+  (auth-to-local       krb5-realm-auth-to-local (default '()))
+  (auth-to-local-names krb5-realm-auth-to-local-names (default '()))
+  (http-anchors        krb5-realm-http-anchors (default '()))
+  (default-domain      krb5-realm-default-domain (default #f))
+  (kpasswd-server      krb5-realm-kpasswd-server (default #f))
+  (master-kdc          krb5-realm-master-kdc (default #f))
+  (v4-instance-convert krb5-realm-v4-instance-convert (default '()))
+  (v4-realm            krb5-realm-v4-realm (default #f)))
+
+
+(define-syntax  guile->krb-cfg
+  (syntax-rules ()
+    ((guile->krb-cfg accessor what)
+     (string-map
+      (lambda (c) (if (eq? c #\-) #\_ c))
+      (string-drop (symbol->string accessor)
+                   (string-length what))))))
+
+(define-syntax cfg-opt-string
+  (syntax-rules ()
+    ((cfg-opt-string accessor realm)
+     (if (accessor realm)
+         (format #f "\n\t~a = ~a"
+                        (guile->krb-cfg 'accessor "krb5-realm-")
+                        (accessor realm))
+         ""))))
+
+
+;; Generates one line of text per list item
+(define-syntax cfg-opt-list
+  (syntax-rules ()
+    ((cfg-opt-list accessor realm)
+     (if (not (null? (accessor realm)))
+         (string-concatenate
+          (map (lambda (item)
+                 (format #f "\n\t~a = ~a"
+                         (guile->krb-cfg 'accessor "krb5-realm-")
+                         item))
+              (accessor realm)))
+     ""))))
+
+(define (krb5-realm->string realm)
+  "Return a string suitable for a krb5.conf fragment representing REALM"
+  (string-append "\n" (krb5-realm-name realm) " = {"
+                 (cfg-opt-string krb5-realm-kdc realm)
+                 (cfg-opt-string krb5-realm-admin-server realm)
+                 (cfg-opt-string krb5-realm-default-domain realm)
+                 (cfg-opt-list krb5-realm-auth-to-local realm)
+                 (cfg-opt-list krb5-realm-http-anchors realm)
+                 (cfg-opt-string krb5-realm-kpasswd-server realm)
+                 (cfg-opt-string krb5-realm-master-kdc realm)
+                 (cfg-opt-string krb5-realm-v4-realm realm)
+                 "\n}"))
+
+
+;; For explanation of these fields see man 5 krb5.conf
+(define-record-type* <krb5-configuration>
+  krb5-configuration    make-krb5-configuration
+  krb5-configuration?
+
+  ;; [libdefaults]
+  (allow-weak-crypto          krb5-configuration-allow-weak-crypto (default #f))
+  (ap-req-checksum-type       krb5-configuration-ap-req-checksum-type (default #f))
+  (canonicalize               krb5-configuration-canonicalize (default #f))
+  (ccache-type                krb5-configuration-ccache-type (default #f))
+  (clockskew                  krb5-configuration-clockskew (default #f))
+  (default-ccache-name        krb5-configuration-default-ccache-name (default #f))
+  (default-client-keytab-name krb5-configuration-default-client-keytab-name
+                                                                     (default #f))
+  (default-keytab-name        krb5-configuration-default-keytab-name (default #f))
+  (default-realm              krb5-configuration-default-realm (default #f))
+  (default-tgs-enctypes       krb5-configuration-default-tgs-enctypes (default #f))
+  (default-tkt-enctypes       krb5-configuration-default-tkt-enctypes (default #f))
+  (dns-canonicalize-hostname  krb5-configuration-dns-canonicalize-hostname
+                              (default #t))
+  (dns-lookup-kdc             krb5-configuration-dns-lookup-kdc
+                              (default #f))
+  (err-fmt                    krb5-configuration-err-fmt (default #f))
+  (extra-addresses            krb5-configuration-extra-addresses
+                              (default #f))
+  (forwardable                krb5-configuration-forwardable (default #t))
+  (ignore-acceptor-hostname   krb5-configuration-ignore-acceptor-hostname
+                              (default #f))
+  (k5login-authoritative      krb5-configuration-k5login-authoritative (default #t))
+  (k5login-directory          krb5-configuration-k5login-directory (default #f))
+  (kcm-mach-service           krb5-configuration-kcm-mach-service
+                                (default "org.h5l.kcm"))
+  (kcm-socket                 krb5-configuration-kcm-socket
+                                (default "/var/run/.heim_org.h5l.kcm-socket"))
+  (kdc-default-options        krb5-configuration-kdc-default-options
+                                (default #f))
+  (kdc-timesync               krb5-configuration-kdc-timesync (default #t))
+  (kdc-req-checksum-type      krb5-configuration-kdc-req-checksum-type (default #f))
+  (noaddresses                krb5-configuration-noaddresses
+                               (default #f))
+  (permitted-enctypes         krb5-configuration-permitted-enctypes
+                              (default #f))
+  (plugin-base-dir            krb5-configuration-plugin-base-dir
+                                (default #f))
+  (preferred-preauth-types    krb5-configuration-preferred-preauth-types
+                              (default #f))
+  (proxiable                  krb5-configuration-proxiable (default #f))
+  (rdns                       krb5-configuration-rdns (default #t))
+  (realm-try-domains          krb5-configuration-realm-try-domains
+                               (default #f))
+  (renew-lifetime             krb5-configuration-renew-lifetime
+                              (default #f))
+  (safe-checksum-type         krb5-configuration-safe-checksum-type
+                              (default #f))
+  (ticket-lifetime            krb5-configuration-ticket-lifetime
+                              (default #f))
+  (udp-preference-limit       krb5-configuration-udp-preference-limit
+                              (default #f))
+  (verify-ap-req-nofail       krb5-configuration-verify-ap-req-nofail
+                              (default #f))
+
+  ;;[realms]
+  (realms                     krb5-configuration-realms)
+
+  ;;[domain_realm]
+  (domain-realm-map           krb5-configuration-domain-realm-map (default '())))
+
+
+(define-syntax cfg-string
+  (syntax-rules ()
+    ((cfg-string accessor config)
+     (if (accessor config)
+         (format #f "\n\t~a = ~a"
+                 (guile->krb-cfg 'accessor "krb5-configuration-")
+                 (accessor config))
+         ""))))
+
+(define-syntax cfg-boolean
+  (syntax-rules ()
+    ((cfg-string accessor config)
+     (format #f "\n\t~a = ~a"
+                    (guile->krb-cfg 'accessor "krb5-configuration-")
+                    (if (accessor config) "true" "false")))))
+
+;; Generates a comma separated list
+(define-syntax cfg-list
+  (syntax-rules ()
+    ((cfg-string accessor config)
+     (if (accessor config)
+         (format #f "\n\t~a = ~a"
+                 (guile->krb-cfg 'accessor "krb5-configuration-")
+                 (fold (lambda (i prev)
+                         (string-append prev
+                                        (if (zero? (string-length prev))
+                                            ""  ", ") i)) ""
+                                            (accessor config))) ""))))
+
+(define (krb5-configuration-file config)
+  "Create a Kerberos 5 configuration file based on CONFIG"
+  (mixed-text-file "krb5.conf"
+
+"[libdefaults]"
+(cfg-string  krb5-configuration-default-realm config)
+(cfg-boolean krb5-configuration-allow-weak-crypto config)
+(cfg-string  krb5-configuration-ap-req-checksum-type config)
+(cfg-boolean krb5-configuration-canonicalize config)
+(cfg-string  krb5-configuration-ccache-type config)
+(cfg-string  krb5-configuration-clockskew config)
+(cfg-string  krb5-configuration-default-ccache-name config)
+(cfg-string  krb5-configuration-default-client-keytab-name config)
+(cfg-string  krb5-configuration-default-keytab-name config)
+(cfg-string  krb5-configuration-default-tgs-enctypes config)
+(cfg-string  krb5-configuration-default-tkt-enctypes config)
+(cfg-boolean krb5-configuration-dns-canonicalize-hostname config)
+(cfg-boolean krb5-configuration-dns-lookup-kdc config)
+(cfg-string  krb5-configuration-err-fmt config)
+(cfg-list    krb5-configuration-extra-addresses config)
+(cfg-boolean krb5-configuration-ignore-acceptor-hostname config)
+(cfg-boolean krb5-configuration-k5login-authoritative config)
+(cfg-string  krb5-configuration-k5login-directory config)
+(cfg-boolean krb5-configuration-forwardable config)
+(cfg-string  krb5-configuration-kcm-mach-service config)
+(cfg-string  krb5-configuration-kcm-socket config)
+(cfg-string  krb5-configuration-kdc-default-options config)
+(cfg-boolean krb5-configuration-kdc-timesync config)
+(cfg-boolean krb5-configuration-proxiable config)
+(cfg-string  krb5-configuration-kdc-req-checksum-type config)
+(cfg-boolean krb5-configuration-noaddresses config)
+(cfg-list    krb5-configuration-permitted-enctypes config)
+(cfg-string  krb5-configuration-plugin-base-dir config)
+(cfg-list    krb5-configuration-preferred-preauth-types config)
+(cfg-boolean krb5-configuration-rdns config)
+(cfg-string  krb5-configuration-realm-try-domains config)
+(cfg-string  krb5-configuration-renew-lifetime config)
+(cfg-string  krb5-configuration-safe-checksum-type config)
+(cfg-string  krb5-configuration-ticket-lifetime config)
+(cfg-string  krb5-configuration-udp-preference-limit config)
+(cfg-boolean krb5-configuration-verify-ap-req-nofail config)
+
+"\n\n[realms]"
+(string-concatenate (map krb5-realm->string (krb5-configuration-realms config)))
+
+"\n"))
+
+
+(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
-- 
2.1.4

Re: [PATCH] gnu: Add kerberos service.

[John Darrington]

[-- Attachment #1: Type: text/plain, Size: 12871 bytes --]

Any comments on this before I push it??

On Wed, Nov 09, 2016 at 08:58:42PM +0100, John Darrington wrote:
     * gnu/services/kerberos.scm (krb5-realm, krb5-configuration,
     krb5-service-type): New variables.
     ---
      gnu/services/kerberos.scm | 230 +++++++++++++++++++++++++++++++++++++++++++++-
      1 file changed, 229 insertions(+), 1 deletion(-)
     
     diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm
     index 144c71b..2147dd8 100644
     --- a/gnu/services/kerberos.scm
     +++ b/gnu/services/kerberos.scm
     @@ -22,9 +22,237 @@
        #:use-module (gnu system pam)
        #:use-module (guix gexp)
        #:use-module (guix records)
     +  #:use-module (srfi srfi-1)
        #: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* <krb5-realm>
     +  krb5-realm      make-krb5-realm
     +  krb5-realm?
     +  (name                krb5-realm-name)
     +
     +  (admin-server        krb5-realm-admin-server)
     +  (kdc                 krb5-realm-kdc)
     +  (auth-to-local       krb5-realm-auth-to-local (default '()))
     +  (auth-to-local-names krb5-realm-auth-to-local-names (default '()))
     +  (http-anchors        krb5-realm-http-anchors (default '()))
     +  (default-domain      krb5-realm-default-domain (default #f))
     +  (kpasswd-server      krb5-realm-kpasswd-server (default #f))
     +  (master-kdc          krb5-realm-master-kdc (default #f))
     +  (v4-instance-convert krb5-realm-v4-instance-convert (default '()))
     +  (v4-realm            krb5-realm-v4-realm (default #f)))
     +
     +
     +(define-syntax  guile->krb-cfg
     +  (syntax-rules ()
     +    ((guile->krb-cfg accessor what)
     +     (string-map
     +      (lambda (c) (if (eq? c #\-) #\_ c))
     +      (string-drop (symbol->string accessor)
     +                   (string-length what))))))
     +
     +(define-syntax cfg-opt-string
     +  (syntax-rules ()
     +    ((cfg-opt-string accessor realm)
     +     (if (accessor realm)
     +         (format #f "\n\t~a = ~a"
     +                        (guile->krb-cfg 'accessor "krb5-realm-")
     +                        (accessor realm))
     +         ""))))
     +
     +
     +;; Generates one line of text per list item
     +(define-syntax cfg-opt-list
     +  (syntax-rules ()
     +    ((cfg-opt-list accessor realm)
     +     (if (not (null? (accessor realm)))
     +         (string-concatenate
     +          (map (lambda (item)
     +                 (format #f "\n\t~a = ~a"
     +                         (guile->krb-cfg 'accessor "krb5-realm-")
     +                         item))
     +              (accessor realm)))
     +     ""))))
     +
     +(define (krb5-realm->string realm)
     +  "Return a string suitable for a krb5.conf fragment representing REALM"
     +  (string-append "\n" (krb5-realm-name realm) " = {"
     +                 (cfg-opt-string krb5-realm-kdc realm)
     +                 (cfg-opt-string krb5-realm-admin-server realm)
     +                 (cfg-opt-string krb5-realm-default-domain realm)
     +                 (cfg-opt-list krb5-realm-auth-to-local realm)
     +                 (cfg-opt-list krb5-realm-http-anchors realm)
     +                 (cfg-opt-string krb5-realm-kpasswd-server realm)
     +                 (cfg-opt-string krb5-realm-master-kdc realm)
     +                 (cfg-opt-string krb5-realm-v4-realm realm)
     +                 "\n}"))
     +
     +
     +;; For explanation of these fields see man 5 krb5.conf
     +(define-record-type* <krb5-configuration>
     +  krb5-configuration    make-krb5-configuration
     +  krb5-configuration?
     +
     +  ;; [libdefaults]
     +  (allow-weak-crypto          krb5-configuration-allow-weak-crypto (default #f))
     +  (ap-req-checksum-type       krb5-configuration-ap-req-checksum-type (default #f))
     +  (canonicalize               krb5-configuration-canonicalize (default #f))
     +  (ccache-type                krb5-configuration-ccache-type (default #f))
     +  (clockskew                  krb5-configuration-clockskew (default #f))
     +  (default-ccache-name        krb5-configuration-default-ccache-name (default #f))
     +  (default-client-keytab-name krb5-configuration-default-client-keytab-name
     +                                                                     (default #f))
     +  (default-keytab-name        krb5-configuration-default-keytab-name (default #f))
     +  (default-realm              krb5-configuration-default-realm (default #f))
     +  (default-tgs-enctypes       krb5-configuration-default-tgs-enctypes (default #f))
     +  (default-tkt-enctypes       krb5-configuration-default-tkt-enctypes (default #f))
     +  (dns-canonicalize-hostname  krb5-configuration-dns-canonicalize-hostname
     +                              (default #t))
     +  (dns-lookup-kdc             krb5-configuration-dns-lookup-kdc
     +                              (default #f))
     +  (err-fmt                    krb5-configuration-err-fmt (default #f))
     +  (extra-addresses            krb5-configuration-extra-addresses
     +                              (default #f))
     +  (forwardable                krb5-configuration-forwardable (default #t))
     +  (ignore-acceptor-hostname   krb5-configuration-ignore-acceptor-hostname
     +                              (default #f))
     +  (k5login-authoritative      krb5-configuration-k5login-authoritative (default #t))
     +  (k5login-directory          krb5-configuration-k5login-directory (default #f))
     +  (kcm-mach-service           krb5-configuration-kcm-mach-service
     +                                (default "org.h5l.kcm"))
     +  (kcm-socket                 krb5-configuration-kcm-socket
     +                                (default "/var/run/.heim_org.h5l.kcm-socket"))
     +  (kdc-default-options        krb5-configuration-kdc-default-options
     +                                (default #f))
     +  (kdc-timesync               krb5-configuration-kdc-timesync (default #t))
     +  (kdc-req-checksum-type      krb5-configuration-kdc-req-checksum-type (default #f))
     +  (noaddresses                krb5-configuration-noaddresses
     +                               (default #f))
     +  (permitted-enctypes         krb5-configuration-permitted-enctypes
     +                              (default #f))
     +  (plugin-base-dir            krb5-configuration-plugin-base-dir
     +                                (default #f))
     +  (preferred-preauth-types    krb5-configuration-preferred-preauth-types
     +                              (default #f))
     +  (proxiable                  krb5-configuration-proxiable (default #f))
     +  (rdns                       krb5-configuration-rdns (default #t))
     +  (realm-try-domains          krb5-configuration-realm-try-domains
     +                               (default #f))
     +  (renew-lifetime             krb5-configuration-renew-lifetime
     +                              (default #f))
     +  (safe-checksum-type         krb5-configuration-safe-checksum-type
     +                              (default #f))
     +  (ticket-lifetime            krb5-configuration-ticket-lifetime
     +                              (default #f))
     +  (udp-preference-limit       krb5-configuration-udp-preference-limit
     +                              (default #f))
     +  (verify-ap-req-nofail       krb5-configuration-verify-ap-req-nofail
     +                              (default #f))
     +
     +  ;;[realms]
     +  (realms                     krb5-configuration-realms)
     +
     +  ;;[domain_realm]
     +  (domain-realm-map           krb5-configuration-domain-realm-map (default '())))
     +
     +
     +(define-syntax cfg-string
     +  (syntax-rules ()
     +    ((cfg-string accessor config)
     +     (if (accessor config)
     +         (format #f "\n\t~a = ~a"
     +                 (guile->krb-cfg 'accessor "krb5-configuration-")
     +                 (accessor config))
     +         ""))))
     +
     +(define-syntax cfg-boolean
     +  (syntax-rules ()
     +    ((cfg-string accessor config)
     +     (format #f "\n\t~a = ~a"
     +                    (guile->krb-cfg 'accessor "krb5-configuration-")
     +                    (if (accessor config) "true" "false")))))
     +
     +;; Generates a comma separated list
     +(define-syntax cfg-list
     +  (syntax-rules ()
     +    ((cfg-string accessor config)
     +     (if (accessor config)
     +         (format #f "\n\t~a = ~a"
     +                 (guile->krb-cfg 'accessor "krb5-configuration-")
     +                 (fold (lambda (i prev)
     +                         (string-append prev
     +                                        (if (zero? (string-length prev))
     +                                            ""  ", ") i)) ""
     +                                            (accessor config))) ""))))
     +
     +(define (krb5-configuration-file config)
     +  "Create a Kerberos 5 configuration file based on CONFIG"
     +  (mixed-text-file "krb5.conf"
     +
     +"[libdefaults]"
     +(cfg-string  krb5-configuration-default-realm config)
     +(cfg-boolean krb5-configuration-allow-weak-crypto config)
     +(cfg-string  krb5-configuration-ap-req-checksum-type config)
     +(cfg-boolean krb5-configuration-canonicalize config)
     +(cfg-string  krb5-configuration-ccache-type config)
     +(cfg-string  krb5-configuration-clockskew config)
     +(cfg-string  krb5-configuration-default-ccache-name config)
     +(cfg-string  krb5-configuration-default-client-keytab-name config)
     +(cfg-string  krb5-configuration-default-keytab-name config)
     +(cfg-string  krb5-configuration-default-tgs-enctypes config)
     +(cfg-string  krb5-configuration-default-tkt-enctypes config)
     +(cfg-boolean krb5-configuration-dns-canonicalize-hostname config)
     +(cfg-boolean krb5-configuration-dns-lookup-kdc config)
     +(cfg-string  krb5-configuration-err-fmt config)
     +(cfg-list    krb5-configuration-extra-addresses config)
     +(cfg-boolean krb5-configuration-ignore-acceptor-hostname config)
     +(cfg-boolean krb5-configuration-k5login-authoritative config)
     +(cfg-string  krb5-configuration-k5login-directory config)
     +(cfg-boolean krb5-configuration-forwardable config)
     +(cfg-string  krb5-configuration-kcm-mach-service config)
     +(cfg-string  krb5-configuration-kcm-socket config)
     +(cfg-string  krb5-configuration-kdc-default-options config)
     +(cfg-boolean krb5-configuration-kdc-timesync config)
     +(cfg-boolean krb5-configuration-proxiable config)
     +(cfg-string  krb5-configuration-kdc-req-checksum-type config)
     +(cfg-boolean krb5-configuration-noaddresses config)
     +(cfg-list    krb5-configuration-permitted-enctypes config)
     +(cfg-string  krb5-configuration-plugin-base-dir config)
     +(cfg-list    krb5-configuration-preferred-preauth-types config)
     +(cfg-boolean krb5-configuration-rdns config)
     +(cfg-string  krb5-configuration-realm-try-domains config)
     +(cfg-string  krb5-configuration-renew-lifetime config)
     +(cfg-string  krb5-configuration-safe-checksum-type config)
     +(cfg-string  krb5-configuration-ticket-lifetime config)
     +(cfg-string  krb5-configuration-udp-preference-limit config)
     +(cfg-boolean krb5-configuration-verify-ap-req-nofail config)
     +
     +"\n\n[realms]"
     +(string-concatenate (map krb5-realm->string (krb5-configuration-realms config)))
     +
     +"\n"))
     +
     +
     +(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
     -- 
     2.1.4
     

-- 
Avoid eavesdropping.  Send strong encrypted email.
PGP Public key ID: 1024D/2DE827B3 
fingerprint = 8797 A26D 0854 2EAB 0285  A290 8A67 719C 2DE8 27B3
See http://sks-keyservers.net or any PGP keyserver for public key.


[-- Attachment #2: Digital signature --]
[-- Type: application/pgp-signature, Size: 181 bytes --]

Re: [PATCH] gnu: Add kerberos service.

[Ludovic Courtès]

Hello!

John Darrington <jmd@gnu.org> skribis:

> * gnu/services/kerberos.scm (krb5-realm, krb5-configuration,
> krb5-service-type): New variables.

Could you add documentation in guix.texi, along with an example of how
to use it?

I very strongly encourage you to write a system test for this as well.
Essentially, it’s just about writing down in a file a test that you’ve
already run anyway.  I’m happy to help if needed.  The main ideas are
described in
<https://www.gnu.org/software/guix/news/guixsd-system-tests.html>.

(I think this will become a requirement for future patches.  :-))

> +(define-record-type* <krb5-realm>
> +  krb5-realm      make-krb5-realm
> +  krb5-realm?
> +  (name                krb5-realm-name)
> +
> +  (admin-server        krb5-realm-admin-server)
> +  (kdc                 krb5-realm-kdc)
> +  (auth-to-local       krb5-realm-auth-to-local (default '()))
> +  (auth-to-local-names krb5-realm-auth-to-local-names (default '()))
> +  (http-anchors        krb5-realm-http-anchors (default '()))
> +  (default-domain      krb5-realm-default-domain (default #f))
> +  (kpasswd-server      krb5-realm-kpasswd-server (default #f))
> +  (master-kdc          krb5-realm-master-kdc (default #f))
> +  (v4-instance-convert krb5-realm-v4-instance-convert (default '()))
> +  (v4-realm            krb5-realm-v4-realm (default #f)))

I find it helpful to add a one- or two-line comment above stating what
this is, and margin comments next to the fields to give an idea of what
their type is.

Could you try something along these lines?

> +(define-syntax  guile->krb-cfg
> +  (syntax-rules ()
> +    ((guile->krb-cfg accessor what)
> +     (string-map
> +      (lambda (c) (if (eq? c #\-) #\_ c))
> +      (string-drop (symbol->string accessor)
> +                   (string-length what))))))
> +
> +(define-syntax cfg-opt-string
> +  (syntax-rules ()
> +    ((cfg-opt-string accessor realm)
> +     (if (accessor realm)
> +         (format #f "\n\t~a = ~a"
> +                        (guile->krb-cfg 'accessor "krb5-realm-")
> +                        (accessor realm))
> +         ""))))
> +
> +
> +;; Generates one line of text per list item
> +(define-syntax cfg-opt-list
> +  (syntax-rules ()
> +    ((cfg-opt-list accessor realm)
> +     (if (not (null? (accessor realm)))
> +         (string-concatenate
> +          (map (lambda (item)
> +                 (format #f "\n\t~a = ~a"
> +                         (guile->krb-cfg 'accessor "krb5-realm-")
> +                         item))
> +              (accessor realm)))
> +     ""))))

Would Andy’s ‘define-configuration’ (in mail.scm and cups.scm) be usable
here, possibly with some adjustments?  It has the advantage that
configuration fields, their types, and their docstring all appear at the
same place.  I think we should consolidate it into a single API.

If not, please mind the naming convention (info "(guix) Formatting
Code"), and use ‘define-syntax-rule’ for macros with a single pattern.

Perhaps pass the whole file through M-x indent-region to fix
inconsistencies.

> +;; For explanation of these fields see man 5 krb5.conf
> +(define-record-type* <krb5-configuration>
> +  krb5-configuration    make-krb5-configuration
> +  krb5-configuration?
> +
> +  ;; [libdefaults]
> +  (allow-weak-crypto          krb5-configuration-allow-weak-crypto (default #f))
> +  (ap-req-checksum-type       krb5-configuration-ap-req-checksum-type (default #f))
> +  (canonicalize               krb5-configuration-canonicalize (default #f))
> +  (ccache-type                krb5-configuration-ccache-type (default #f))
> +  (clockskew                  krb5-configuration-clockskew (default #f))
> +  (default-ccache-name        krb5-configuration-default-ccache-name (default #f))
> +  (default-client-keytab-name krb5-configuration-default-client-keytab-name
> +                                                                     (default #f))
> +  (default-keytab-name        krb5-configuration-default-keytab-name (default #f))
> +  (default-realm              krb5-configuration-default-realm (default #f))
> +  (default-tgs-enctypes       krb5-configuration-default-tgs-enctypes (default #f))
> +  (default-tkt-enctypes       krb5-configuration-default-tkt-enctypes (default #f))
> +  (dns-canonicalize-hostname  krb5-configuration-dns-canonicalize-hostname
> +                              (default #t))
> +  (dns-lookup-kdc             krb5-configuration-dns-lookup-kdc
> +                              (default #f))
> +  (err-fmt                    krb5-configuration-err-fmt (default #f))
> +  (extra-addresses            krb5-configuration-extra-addresses
> +                              (default #f))
> +  (forwardable                krb5-configuration-forwardable (default #t))
> +  (ignore-acceptor-hostname   krb5-configuration-ignore-acceptor-hostname
> +                              (default #f))
> +  (k5login-authoritative      krb5-configuration-k5login-authoritative (default #t))
> +  (k5login-directory          krb5-configuration-k5login-directory (default #f))
> +  (kcm-mach-service           krb5-configuration-kcm-mach-service
> +                                (default "org.h5l.kcm"))
> +  (kcm-socket                 krb5-configuration-kcm-socket
> +                                (default "/var/run/.heim_org.h5l.kcm-socket"))
> +  (kdc-default-options        krb5-configuration-kdc-default-options
> +                                (default #f))
> +  (kdc-timesync               krb5-configuration-kdc-timesync (default #t))
> +  (kdc-req-checksum-type      krb5-configuration-kdc-req-checksum-type (default #f))
> +  (noaddresses                krb5-configuration-noaddresses
> +                               (default #f))
> +  (permitted-enctypes         krb5-configuration-permitted-enctypes
> +                              (default #f))
> +  (plugin-base-dir            krb5-configuration-plugin-base-dir
> +                                (default #f))
> +  (preferred-preauth-types    krb5-configuration-preferred-preauth-types
> +                              (default #f))
> +  (proxiable                  krb5-configuration-proxiable (default #f))
> +  (rdns                       krb5-configuration-rdns (default #t))
> +  (realm-try-domains          krb5-configuration-realm-try-domains
> +                               (default #f))
> +  (renew-lifetime             krb5-configuration-renew-lifetime
> +                              (default #f))
> +  (safe-checksum-type         krb5-configuration-safe-checksum-type
> +                              (default #f))
> +  (ticket-lifetime            krb5-configuration-ticket-lifetime
> +                              (default #f))
> +  (udp-preference-limit       krb5-configuration-udp-preference-limit
> +                              (default #f))
> +  (verify-ap-req-nofail       krb5-configuration-verify-ap-req-nofail
> +                              (default #f))
> +
> +  ;;[realms]
> +  (realms                     krb5-configuration-realms)
> +
> +  ;;[domain_realm]
> +  (domain-realm-map           krb5-configuration-domain-realm-map (default '())))

Woow!  :-)  Please use full separate words; use question marks for
Boolean 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)))))

So this service doesn’t do anything by itself.  Perhaps it should also
create a Shepherd service for the Kerberos daemon, or something like
that?

Thank you!

Ludo’.

Re: [PATCH] gnu: Add kerberos service.

[John Darrington]

[-- Attachment #1: Type: text/plain, Size: 10337 bytes --]

On Fri, Nov 18, 2016 at 11:51:16PM +0100, Ludovic Court??s wrote:
     Hello!
     
     John Darrington <jmd@gnu.org> skribis:
     
     > * gnu/services/kerberos.scm (krb5-realm, krb5-configuration,
     > krb5-service-type): New variables.
     
     Could you add documentation in guix.texi, along with an example of how
     to use it?

I can make an attempt to do that.   Kerberos however is a complicated thing
with a large number of options - not all of which I pretend to understand.
I think it is better to have something undocumented rather than documented
wrong.   - and I can give an example of how *I* use it - but that should
not be regarded as a canonical example of how everyone should use it.
     
     I very strongly encourage you to write a system test for this as well.
     Essentially, it???s just about writing down in a file a test that you???ve
     already run anyway.  I???m happy to help if needed.  The main ideas are
     described in
     <https://www.gnu.org/software/guix/news/guixsd-system-tests.html>.
     
You are right.  Tests for things like this are needed.  But we have a chicken
and egg situation.  We can't really write a test for the client without a server.
And we can't write a test for the server without a client. ... something has
to come first.   Of course I could, wait until I have absolutely everything
done before I commit, but then I a) run the risk of losing everything, if  I
have a disk crash; and b) rule out all possibility of getting any contribution
from others.

     > +(define-record-type* <krb5-realm>
     > +  krb5-realm      make-krb5-realm
     > +  krb5-realm?
     > +  (name                krb5-realm-name)
     > +
     > +  (admin-server        krb5-realm-admin-server)
     > +  (kdc                 krb5-realm-kdc)
     > +  (auth-to-local       krb5-realm-auth-to-local (default '()))
     > +  (auth-to-local-names krb5-realm-auth-to-local-names (default '()))
     > +  (http-anchors        krb5-realm-http-anchors (default '()))
     > +  (default-domain      krb5-realm-default-domain (default #f))
     > +  (kpasswd-server      krb5-realm-kpasswd-server (default #f))
     > +  (master-kdc          krb5-realm-master-kdc (default #f))
     > +  (v4-instance-convert krb5-realm-v4-instance-convert (default '()))
     > +  (v4-realm            krb5-realm-v4-realm (default #f)))
     
     I find it helpful to add a one- or two-line comment above stating what
     this is, and margin comments next to the fields to give an idea of what
     their type is.
     
     Could you try something along these lines?

Again most of the info would be copied from the manpage krb5.conf(5).  I can 
do that if you think it would be useful.
     
     > +(define-syntax  guile->krb-cfg
     > +  (syntax-rules ()
     > +    ((guile->krb-cfg accessor what)
     > +     (string-map
     > +      (lambda (c) (if (eq? c #\-) #\_ c))
     > +      (string-drop (symbol->string accessor)
     > +                   (string-length what))))))
     > +
     > +(define-syntax cfg-opt-string
     > +  (syntax-rules ()
     > +    ((cfg-opt-string accessor realm)
     > +     (if (accessor realm)
     > +         (format #f "\n\t~a = ~a"
     > +                        (guile->krb-cfg 'accessor "krb5-realm-")
     > +                        (accessor realm))
     > +         ""))))
     > +
     > +
     > +;; Generates one line of text per list item
     > +(define-syntax cfg-opt-list
     > +  (syntax-rules ()
     > +    ((cfg-opt-list accessor realm)
     > +     (if (not (null? (accessor realm)))
     > +         (string-concatenate
     > +          (map (lambda (item)
     > +                 (format #f "\n\t~a = ~a"
     > +                         (guile->krb-cfg 'accessor "krb5-realm-")
     > +                         item))
     > +              (accessor realm)))
     > +     ""))))
     
     Would Andy???s ???define-configuration??? (in mail.scm and cups.scm) be usable
     here, possibly with some adjustments?  It has the advantage that
     configuration fields, their types, and their docstring all appear at the
     same place.  I think we should consolidate it into a single API.

I will have a look to see if I can a) understand it; and b) use it in any way.
     
     
     > +;; For explanation of these fields see man 5 krb5.conf
     > +(define-record-type* <krb5-configuration>
     > +  krb5-configuration    make-krb5-configuration
     > +  krb5-configuration?
     > +
     > +  ;; [libdefaults]
     > +  (allow-weak-crypto          krb5-configuration-allow-weak-crypto (default #f))
     > +  (ap-req-checksum-type       krb5-configuration-ap-req-checksum-type (default #f))
     > +  (canonicalize               krb5-configuration-canonicalize (default #f))
     > +  (ccache-type                krb5-configuration-ccache-type (default #f))
     > +  (clockskew                  krb5-configuration-clockskew (default #f))
     > +  (default-ccache-name        krb5-configuration-default-ccache-name (default #f))
     > +  (default-client-keytab-name krb5-configuration-default-client-keytab-name
     > +                                                                     (default #f))
     > +  (default-keytab-name        krb5-configuration-default-keytab-name (default #f))
     > +  (default-realm              krb5-configuration-default-realm (default #f))
     > +  (default-tgs-enctypes       krb5-configuration-default-tgs-enctypes (default #f))
     > +  (default-tkt-enctypes       krb5-configuration-default-tkt-enctypes (default #f))
     > +  (dns-canonicalize-hostname  krb5-configuration-dns-canonicalize-hostname
     > +                              (default #t))
     > +  (dns-lookup-kdc             krb5-configuration-dns-lookup-kdc
     > +                              (default #f))
     > +  (err-fmt                    krb5-configuration-err-fmt (default #f))
     > +  (extra-addresses            krb5-configuration-extra-addresses
     > +                              (default #f))
     > +  (forwardable                krb5-configuration-forwardable (default #t))
     > +  (ignore-acceptor-hostname   krb5-configuration-ignore-acceptor-hostname
     > +                              (default #f))
     > +  (k5login-authoritative      krb5-configuration-k5login-authoritative (default #t))
     > +  (k5login-directory          krb5-configuration-k5login-directory (default #f))
     > +  (kcm-mach-service           krb5-configuration-kcm-mach-service
     > +                                (default "org.h5l.kcm"))
     > +  (kcm-socket                 krb5-configuration-kcm-socket
     > +                                (default "/var/run/.heim_org.h5l.kcm-socket"))
     > +  (kdc-default-options        krb5-configuration-kdc-default-options
     > +                                (default #f))
     > +  (kdc-timesync               krb5-configuration-kdc-timesync (default #t))
     > +  (kdc-req-checksum-type      krb5-configuration-kdc-req-checksum-type (default #f))
     > +  (noaddresses                krb5-configuration-noaddresses
     > +                               (default #f))
     > +  (permitted-enctypes         krb5-configuration-permitted-enctypes
     > +                              (default #f))
     > +  (plugin-base-dir            krb5-configuration-plugin-base-dir
     > +                                (default #f))
     > +  (preferred-preauth-types    krb5-configuration-preferred-preauth-types
     > +                              (default #f))
     > +  (proxiable                  krb5-configuration-proxiable (default #f))
     > +  (rdns                       krb5-configuration-rdns (default #t))
     > +  (realm-try-domains          krb5-configuration-realm-try-domains
     > +                               (default #f))
     > +  (renew-lifetime             krb5-configuration-renew-lifetime
     > +                              (default #f))
     > +  (safe-checksum-type         krb5-configuration-safe-checksum-type
     > +                              (default #f))
     > +  (ticket-lifetime            krb5-configuration-ticket-lifetime
     > +                              (default #f))
     > +  (udp-preference-limit       krb5-configuration-udp-preference-limit
     > +                              (default #f))
     > +  (verify-ap-req-nofail       krb5-configuration-verify-ap-req-nofail
     > +                              (default #f))
     > +
     > +  ;;[realms]
     > +  (realms                     krb5-configuration-realms)
     > +
     > +  ;;[domain_realm]
     > +  (domain-realm-map           krb5-configuration-domain-realm-map (default '())))
     
     Woow!  :-)  Please use full separate words; use question marks for
     Boolean fields.
ok.
     
     > +(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)))))
     
     So this service doesn???t do anything by itself.  Perhaps it should also
     create a Shepherd service for the Kerberos daemon, or something like
     that?

Kerberos is three headed dog.  There is the client, the "key distribution center",
the admin server, the ticket granting server, and the application server.
Ooops! that's 5 heads.

But this service is sufficient to get a client machine up and running and ready to
make requests and receive services from an external KDC and application server.

As you say, once we have a KDC and some simple kerberos enabled service in Guix, then
we can write some end to end tests.  It would be really great if someone can help with
those things.  In the meantime, this is a start.

J'


-- 
Avoid eavesdropping.  Send strong encrypted email.
PGP Public key ID: 1024D/2DE827B3 
fingerprint = 8797 A26D 0854 2EAB 0285  A290 8A67 719C 2DE8 27B3
See http://sks-keyservers.net or any PGP keyserver for public key.


[-- Attachment #2: Digital signature --]
[-- Type: application/pgp-signature, Size: 181 bytes --]

Re: [PATCH] gnu: Add kerberos service.

[Ludovic Courtès]

Hi!

John Darrington <john@darrington.wattle.id.au> skribis:

> On Fri, Nov 18, 2016 at 11:51:16PM +0100, Ludovic Court??s wrote:
>      Hello!
>      
>      John Darrington <jmd@gnu.org> skribis:
>      
>      > * gnu/services/kerberos.scm (krb5-realm, krb5-configuration,
>      > krb5-service-type): New variables.
>      
>      Could you add documentation in guix.texi, along with an example of how
>      to use it?
>
> I can make an attempt to do that.   Kerberos however is a complicated thing
> with a large number of options - not all of which I pretend to understand.
> I think it is better to have something undocumented rather than documented
> wrong.   - and I can give an example of how *I* use it - but that should
> not be regarded as a canonical example of how everyone should use it.

Maybe just give a rough overview in a couple of sentences, then an
example that makes sense to you, and then cross-references to the
upstream manual or documentation.

BTW, is this config file honored by any Kerberos implementation, or just
mit-krb5?

>      I very strongly encourage you to write a system test for this as well.
>      Essentially, it???s just about writing down in a file a test that you???ve
>      already run anyway.  I???m happy to help if needed.  The main ideas are
>      described in
>      <https://www.gnu.org/software/guix/news/guixsd-system-tests.html>.
>      
> You are right.  Tests for things like this are needed.  But we have a chicken
> and egg situation.  We can't really write a test for the client without a server.
> And we can't write a test for the server without a client. ... something has
> to come first.   Of course I could, wait until I have absolutely everything
> done before I commit, but then I a) run the risk of losing everything, if  I
> have a disk crash; and b) rule out all possibility of getting any contribution
> from others.

No you’re right, we can’t delay the contribution endlessly, so we have
to be flexible.  What I want to avoid is simply having big chunks of
code that we don’t really how to use and can’t tell if it works.

>      > +(define-record-type* <krb5-realm>
>      > +  krb5-realm      make-krb5-realm
>      > +  krb5-realm?
>      > +  (name                krb5-realm-name)
>      > +
>      > +  (admin-server        krb5-realm-admin-server)
>      > +  (kdc                 krb5-realm-kdc)
>      > +  (auth-to-local       krb5-realm-auth-to-local (default '()))
>      > +  (auth-to-local-names krb5-realm-auth-to-local-names (default '()))
>      > +  (http-anchors        krb5-realm-http-anchors (default '()))
>      > +  (default-domain      krb5-realm-default-domain (default #f))
>      > +  (kpasswd-server      krb5-realm-kpasswd-server (default #f))
>      > +  (master-kdc          krb5-realm-master-kdc (default #f))
>      > +  (v4-instance-convert krb5-realm-v4-instance-convert (default '()))
>      > +  (v4-realm            krb5-realm-v4-realm (default #f)))
>      
>      I find it helpful to add a one- or two-line comment above stating what
>      this is, and margin comments next to the fields to give an idea of what
>      their type is.
>      
>      Could you try something along these lines?
>
> Again most of the info would be copied from the manpage krb5.conf(5).  I can 
> do that if you think it would be useful.

Just one or two lines, whatever makes sense.

>      > +(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)))))
>      
>      So this service doesn???t do anything by itself.  Perhaps it should also
>      create a Shepherd service for the Kerberos daemon, or something like
>      that?
>
> Kerberos is three headed dog.  There is the client, the "key distribution center",
> the admin server, the ticket granting server, and the application server.
> Ooops! that's 5 heads.
>
> But this service is sufficient to get a client machine up and running and ready to
> make requests and receive services from an external KDC and application server.
>
> As you say, once we have a KDC and some simple kerberos enabled service in Guix, then
> we can write some end to end tests.  It would be really great if someone can help with
> those things.  In the meantime, this is a start.

Heh, OK.

So client libraries of Kerberos implementations read that file?  IOW, is
it useful on its own already?

If the answer is “yes”, then it’s obviously OK to commit, and if it’s
client functionality, we cannot write tests yet, so that’s fine.

Thank you,
Ludo’.

[PATCH] gnu: Add Kerberos client service.

[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))
+
+\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

Re: [PATCH] gnu: Add Kerberos client service.

[Ludovic Courtès]

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’.

[PATCH] gnu: Add Kerberos client service.

[John Darrington]

I'm sending this for another round of review, since I had to change a
few things in gnu/services/configuraiton.scm

[PATCH] gnu: Add Kerberos client service.

[John Darrington]

* doc/guix.texi (Kerberos Services)[Krb5 Service]: New subsubheading.
* gnu/services/kerberos.scm (krb5-service-type): New variable.
---
 doc/guix.texi                  |  87 ++++++++++
 gnu/services/configuration.scm |   4 +-
 gnu/services/kerberos.scm      | 366 ++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 454 insertions(+), 3 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 125e5f0..069bab2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11536,6 +11536,93 @@ remote servers.  Run @command{man smtpd.conf} for more information.
 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 @code{#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/configuration.scm b/gnu/services/configuration.scm
index 9f28aab..5c32cf7 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -30,6 +30,8 @@
             configuration-field-name
             configuration-missing-field
             configuration-field-error
+            configuration-field-getter
+            configuration-field-serializer
             serialize-configuration
             define-configuration
             validate-configuration
@@ -83,7 +85,7 @@
 (define (validate-configuration config fields)
   (for-each (lambda (field)
               (let ((val ((configuration-field-getter field) config)))
-                (unless ((configuration-field-predicate field) val)
+                (unless (or (not val) ((configuration-field-predicate field) val))
                   (configuration-field-error
                    (configuration-field-name field) val))))
             fields))
diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm
index a56f630..059d371 100644
--- a/gnu/services/kerberos.scm
+++ b/gnu/services/kerberos.scm
@@ -17,14 +17,376 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu services kerberos)
-  #:use-module (gnu packages admin)
   #:use-module (gnu services)
+  #:use-module (gnu services configuration)
   #: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 (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 (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
-- 
2.1.4

Re: [PATCH] gnu: Add Kerberos client service.

[Ludovic Courtès]

John Darrington <jmd@gnu.org> skribis:

> * doc/guix.texi (Kerberos Services)[Krb5 Service]: New subsubheading.
> * gnu/services/kerberos.scm (krb5-service-type): New variable.

Please mention the configuration.scm changes.

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

Please take into account my previous suggestions:

  https://lists.gnu.org/archive/html/guix-devel/2016-11/msg00922.html

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

Ditto.

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

Ditto.

> +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.

Shouldn’t it be a single comma in @uref?  Also, @file{krb5.conf}.

> +@end deftp
> +
> +

Extra newline.

>  (define (validate-configuration config fields)
>    (for-each (lambda (field)
>                (let ((val ((configuration-field-getter field) config)))
> -                (unless ((configuration-field-predicate field) val)
> +                (unless (or (not val) ((configuration-field-predicate field) val))
>                    (configuration-field-error
>                     (configuration-field-name field) val))))

Here you’re assuming that when VAL is #f, it’s necessary invalid, an
assumption that’s questionable and wasn’t made until now.

Can you instead change your own field predicate to do that?

> +(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)
> +                               #\-)
> +                 "_")))

Please add a docstring to explain what it does and/or an example.

> +(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) ""))

Align both arms of the ‘if’.

> +;; 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)))))

Rather:

  (define (end-point? val)
    (match val
      ((? string?) #t)
      (((? string?) . (? integer?)) #t)
      (_ #f)))  ;do we need this catch-all case?

> +(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)))))

No car/cdr please.

> +(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))

No ‘else’ here?  Looks like a bug.

> +(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))

How much of this is copied from configuration.scm?  I don’t want
duplicated code here.

> +(define (realm-list? val)
> +  (and (list? val)
> +       (and-map (lambda (x) (krb5-realm? x)) val)))

Rather:

  (match val
    (((? krb5-realm?) ...) #t)
    (_ #f))

Could you send an updated patch?

Thank you!

Ludo’.

Re: [PATCH] gnu: Add Kerberos client service.

[John Darrington]

[-- Attachment #1: Type: text/plain, Size: 2682 bytes --]

On Wed, Nov 30, 2016 at 02:09:17PM +0100, Ludovic Court??s wrote:
     John Darrington <jmd@gnu.org> skribis:
     
     > * doc/guix.texi (Kerberos Services)[Krb5 Service]: New subsubheading.
     > * gnu/services/kerberos.scm (krb5-service-type): New variable.
     
     Please mention the configuration.scm changes.

ok.
     
     > +@subsubheading Krb5 Service
     > +
     > +The krb5 service provides the configuration for Kerberos clients, using
     > +the MIT implementation of the Kerberos protocol version@tie{}5.
     
     Please take into account my previous suggestions:
     
       https://lists.gnu.org/archive/html/guix-devel/2016-11/msg00922.html

ok
     
     
     Shouldn???t it be a single comma in @uref?  

I don't think so.  The Texinfo manual suggests, that in this case, the second arg
should be empty.
     
     >  (define (validate-configuration config fields)
     >    (for-each (lambda (field)
     >                (let ((val ((configuration-field-getter field) config)))
     > -                (unless ((configuration-field-predicate field) val)
     > +                (unless (or (not val) ((configuration-field-predicate field) val))
     >                    (configuration-field-error
     >                     (configuration-field-name field) val))))
     
     Here you???re assuming that when VAL is #f, it???s necessary invalid, an
     assumption that???s questionable and wasn???t made until now.

No.  I'm assuming the exact opposite, namely, that #f is a *valid* value.
     
     Can you instead change your own field predicate to do that?

I could do that, but then I'd be defining a lot of them which are substantially 
identical to existing ones - and below, you say that you don't want me to 
duplicate code ...
     
     > +
     > +(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))
     
     No ???else??? here?  Looks like a bug.

No. The idea is, that if fields are #f then they output absolutely nothing.
     
     How much of this is copied from configuration.scm?  I don???t want
     duplicated code here.

Much of it was copied, but modified where appropriate.  None is identical
I don't think.
     
J'
     

-- 
Avoid eavesdropping.  Send strong encrypted email.
PGP Public key ID: 1024D/2DE827B3 
fingerprint = 8797 A26D 0854 2EAB 0285  A290 8A67 719C 2DE8 27B3
See http://sks-keyservers.net or any PGP keyserver for public key.


[-- Attachment #2: Digital signature --]
[-- Type: application/pgp-signature, Size: 181 bytes --]

Re: [PATCH] gnu: Add Kerberos client service.

[Andy Wingo]

On Wed 30 Nov 2016 14:09, ludo@gnu.org (Ludovic Courtès) writes:

>>  (define (validate-configuration config fields)
>>    (for-each (lambda (field)
>>                (let ((val ((configuration-field-getter field) config)))
>> -                (unless ((configuration-field-predicate field) val)
>> +                (unless (or (not val) ((configuration-field-predicate field) val))
>>                    (configuration-field-error
>>                     (configuration-field-name field) val))))
>
> Here you’re assuming that when VAL is #f, it’s necessary invalid, an
> assumption that’s questionable and wasn’t made until now.
>
> Can you instead change your own field predicate to do that?

Agreed; the usual way to do this is to define the default value as a
sentinel value that your field predicate rejects.  E.g.

  (define unset-field (list 'unset-field))

You'd make the default value be `unset-field' (by reference).  Then
assuming you defined a field of type "foo" then assuming you have an
associated predicate `foo?', you can do

  (define (predicate/not-unset pred)
    (lambda (x) (and (not (eq? x unset-field)) (pred x))))

  (define foo? (predicate/not-unset foo?))

Andy

[PATCH] gnu: Add Kerberos client service.

[John Darrington]

* doc/guix.texi (Kerberos Services)[Krb5 Service]: New subsubheading.
* gnu/services/kerberos.scm (krb5-service-type): New variable.
* gnu/services/configuration.scm (configuration-field-serializer,
  configuration-field-getter): Export variables.
---
 doc/guix.texi                  |  93 ++++++++++
 gnu/services/configuration.scm |   2 +
 gnu/services/kerberos.scm      | 377 ++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 470 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 3b4ba48..a214354 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -11542,6 +11542,99 @@ remote servers.  Run @command{man smtpd.conf} for more information.
 The @code{(gnu services kerberos)} module provides services relating to
 the authentication protocol @dfn{Kerberos}.
 
+@subsubheading Krb5 Service
+
+Programs using Kerberos client library packages normally
+expect a configuration file in @file{/etc/krb5.conf}.
+This service generates such a file from a definition provided in the
+operating system declaration.
+It does not cause any daemon to be started.
+
+No keytab filea are provided by this service.  You must explicitly create these.
+This service is known to work with the MIT client library, @code{mit-krb5}.
+Other implementations have not been tested.
+
+@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 @code{#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/configuration.scm b/gnu/services/configuration.scm
index 9f28aab..94c5f21 100644
--- a/gnu/services/configuration.scm
+++ b/gnu/services/configuration.scm
@@ -30,6 +30,8 @@
             configuration-field-name
             configuration-missing-field
             configuration-field-error
+            configuration-field-serializer
+            configuration-field-getter
             serialize-configuration
             define-configuration
             validate-configuration
diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm
index a56f630..b23085d 100644
--- a/gnu/services/kerberos.scm
+++ b/gnu/services/kerberos.scm
@@ -17,14 +17,387 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu services kerberos)
-  #:use-module (gnu packages admin)
   #:use-module (gnu services)
+  #:use-module (gnu services configuration)
   #: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 unset-field (list 'unset-field))
+
+(define (predicate/unset pred)
+  (lambda (x) (or (eq? x unset-field) (pred x))))
+
+(define string/unset? (predicate/unset string?))
+(define boolean/unset? (predicate/unset boolean?))
+(define integer/unset? (predicate/unset integer?))
+
+(define (uglify-field-name field-name)
+  "Return FIELD-NAME with all instances of '-' replaced by '_' and any
+trailing '?' removed."
+  (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/unset field-name val)
+  (if (not (eq? val unset-field))
+      (serialize-field* field-name val)))
+
+(define (serialize-integer/unset field-name val)
+  (if (not (eq? val unset-field))
+      (serialize-field* field-name val)))
+
+(define (serialize-boolean/unset field-name val)
+  (if (not (eq? val unset-field))
+      (serialize-field* field-name
+                        (if val "true" "false"))))
+
+
+;; An end-point is an address such as "192.168.0.1"
+;; or an address port pair ("string/unset.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 (serialize-space-separated-string-list/unset field-name val)
+  (if (not (eq? val unset-field))
+      (serialize-field* field-name (string-join val " "))))
+
+(define space-separated-string-list/unset?
+  (predicate/unset space-separated-string-list?))
+
+(define comma-separated-integer-list/unset?
+  (predicate/unset (lambda (val)
+                     (and (list? val)
+                          (and-map (lambda (x) (integer? x))
+                                   val)))))
+
+(define (serialize-comma-separated-integer-list/unset field-name val)
+  (if (not (eq? val unset-field))
+      (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? (predicate/unset
+                    (lambda (val)
+                      (string-prefix? "/" val))))
+
+(define (serialize-file-name field-name val)
+  (if (not (eq? val unset-field))
+      (serialize-string field-name val)))
+
+(define (non-negative-integer? val)
+  (and (exact-integer? val) (not (negative? val))))
+
+(define (serialize-non-negative-integer/unset field-name val)
+  (if (not (eq? val unset-field))
+      (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 non-negative-integer/unset? (predicate/unset non-negative-integer?))
+
+(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/unset unset-field)
+   "The name of the realm.")
+
+  (kdc
+   (end-point unset-field)
+   "The host and port on which the realm's Key Distribution Server listens.")
+
+  (admin-server
+   (string/unset unset-field)
+   "The Host running the administration server for the realm.")
+
+  (master-kdc
+   (string/unset unset-field)
+   "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/unset unset-field)
+   "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/unset unset-field)
+    "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/unset unset-field)
+   "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/unset unset-field)
+   "If true, permits access to services which only offer weak encryption.")
+
+  (ap-req-checksum-type
+   (non-negative-integer/unset unset-field)
+   "The type of the AP-REQ checksum.")
+
+  (canonicalize?
+   (boolean/unset unset-field)
+   "Should principals in initial ticket requests be canonicalized?")
+
+  (ccache-type
+   (non-negative-integer/unset unset-field)
+   "The format of the credential cache type.")
+
+  (clockskew
+   (non-negative-integer/unset unset-field)
+   "Maximum allowable clock skew in seconds (default 300).")
+
+  (default-ccache-name
+    (file-name unset-field)
+    "The name of the default credential cache.")
+
+  (default-client-keytab-name
+    (file-name unset-field)
+    "The name of the default keytab for client credentials.")
+
+  (default-keytab-name
+    (file-name unset-field)
+    "The name of the default keytab file.")
+
+  (default-realm
+    (string/unset unset-field)
+    "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/unset  unset-field)
+   "Whether name lookups will be used to canonicalize host names for use in 
+service principal names.")
+
+  (dns-lookup-kdc?
+   (boolean/unset unset-field)
+ "Should DNS SRV records should be used to locate the KDCs and other servers 
+not appearing in the realm specification")
+
+  (err-fmt
+   (string/unset unset-field)
+   "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/unset unset-field)
+   "Should initial tickets be forwardable by default?")
+
+  (ignore-acceptor-hostname?
+   (boolean/unset unset-field)
+   "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/unset unset-field)
+   "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/unset unset-field)
+   "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/unset unset-field)
+   "The name of the bootstrap service used to contact the KCM daemon for the 
+KCM credential cache type.")
+
+  (kcm-socket
+   (file-name unset-field)
+ "Path to the Unix domain socket used to access the KCM daemon for the KCM 
+credential cache type.")
+
+  (kdc-default-options
+   (non-negative-integer/unset unset-field)
+   "Default KDC options (logored for multiple values) when requesting initial 
+tickets.")
+
+  (kdc-timesync
+   (non-negative-integer/unset unset-field)
+   "Attempt to compensate for clock skew between the KDC and client.")
+
+  (kdc-req-checksum-type
+   (non-negative-integer/unset unset-field)
+   "The type of checksum to use for the KDC requests. Relevant only for DES 
+keys")
+
+  (noaddresses?
+   (boolean/unset unset-field)
+   "If true, initial ticket requests will not be made with address restrictions.
+This enables their use across NATs.")
+
+  (permitted-enctypes
+   (space-separated-string-list/unset unset-field)
+   "All encryption types that are permitted for use in session key encryption.")
+
+  (plugin-base-dir
+   (file-name unset-field)
+   "The directory where krb5 plugins are located.")
+
+  (preferred-preauth-types
+   (comma-separated-integer-list/unset unset-field)
+   "The preferred pre-authentication types which the client will attempt before 
+others.")
+
+  (proxiable?
+   (boolean/unset unset-field)
+   "Should initial tickets be proxiable by default?")
+
+  (rdns?
+   (boolean/unset unset-field)
+   "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/unset unset-field)
+   "Should a host's domain components should be used to determine the Kerberos 
+realm of the host.")
+
+  (renew-lifetime
+   (non-negative-integer/unset unset-field)
+   "The default renewable lifetime for initial ticket requests.")
+
+  (safe-checksum-type
+   (non-negative-integer/unset unset-field)
+   "The type of checksum to use for the KRB-SAFE requests.")
+
+  (ticket-lifetime
+   (non-negative-integer/unset unset-field)
+   "The default lifetime for initial ticket requests.")
+
+  (udp-preference-limit
+   (non-negative-integer/unset unset-field)
+   "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-rereq-nofail?
+   (boolean/unset unset-field)
+ "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
-- 
2.1.4

Re: [PATCH] gnu: Add Kerberos client service.

[Ludovic Courtès]

John Darrington <jmd@gnu.org> skribis:

> * doc/guix.texi (Kerberos Services)[Krb5 Service]: New subsubheading.
> * gnu/services/kerberos.scm (krb5-service-type): New variable.
> * gnu/services/configuration.scm (configuration-field-serializer,
>   configuration-field-getter): Export variables.

[...]

> +@subsubheading Krb5 Service
> +
> +Programs using Kerberos client library packages normally

s/Kerberos client library packages/a Kerberos client library/

> +No keytab filea are provided by this service.  You must explicitly create these.
                 ^
Typo.

Also ``keytab'', since we don't know what that is.

> +(define (serialize-string/unset field-name val)
> +  (if (not (eq? val unset-field))
> +      (serialize-field* field-name val)))
> +
> +(define (serialize-integer/unset field-name val)
> +  (if (not (eq? val unset-field))
> +      (serialize-field* field-name val)))
> +
> +(define (serialize-boolean/unset field-name val)
> +  (if (not (eq? val unset-field))
> +      (serialize-field* field-name
> +                        (if val "true" "false"))))
> +

Please use ‘when’ or ‘unless’ for single-arm ‘if’ (there are other
occurrences of this further down in this file.)  It makes it clear that
this is for effect.

(At some point we should add an explicit ‘port’ parameter for these
serialize procedures.)

> +;; An end-point is an address such as "192.168.0.1"
> +;; or an address port pair ("string/unset.example.com" . 109)
> +(define (end-point? val)
> +  (or (string? val)
> +      (and (pair? val)
> +           (string? (car val))
> +           (integer? (cdr val)))))

See <https://lists.gnu.org/archive/html/guix-devel/2016-11/msg01252.html>.

> +(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)))))

See <https://lists.gnu.org/archive/html/guix-devel/2016-11/msg01252.html>.

> +(define (serialize-space-separated-string-list/unset field-name val)
> +  (if (not (eq? val unset-field))
> +      (serialize-field* field-name (string-join val " "))))

‘unless’.

OK with all these changes.

In the future, could you write a short summary of the changes when you
submit a new revision of a patch, to make it easier to keep track of it?

Thanks,
Ludo’.