diff options
Diffstat (limited to 'gnu/services')
| -rw-r--r-- | gnu/services/base.scm | 38 | ||||
| -rw-r--r-- | gnu/services/configuration.scm | 2 | ||||
| -rw-r--r-- | gnu/services/cups.scm | 2 | ||||
| -rw-r--r-- | gnu/services/kerberos.scm | 378 |
4 files changed, 388 insertions, 32 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index afbecdb47e..2b3d3f8548 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -252,6 +252,8 @@ FILE-SYSTEM." (device (file-system-device file-system)) (type (file-system-type file-system)) (title (file-system-title file-system)) + (flags (file-system-flags file-system)) + (options (file-system-options file-system)) (check? (file-system-check? file-system)) (create? (file-system-create-mount-point? file-system)) (dependencies (file-system-dependencies file-system))) @@ -264,34 +266,12 @@ FILE-SYSTEM." ,@(map dependency->shepherd-service-name dependencies))) (documentation "Check, mount, and unmount the given file system.") (start #~(lambda args - ;; FIXME: Use or factorize with 'mount-file-system'. - (let ((device (canonicalize-device-spec #$device '#$title)) - (flags #$(mount-flags->bit-mask - (file-system-flags file-system)))) - #$(if create? - #~(mkdir-p #$target) - #~#t) - #$(if check? - #~(begin - ;; Make sure fsck.ext2 & co. can be found. - (setenv "PATH" - (string-append - #$e2fsprogs "/sbin:" - "/run/current-system/profile/sbin:" - (getenv "PATH"))) - (check-file-system device #$type)) - #~#t) - - (mount device #$target #$type flags - #$(file-system-options file-system)) - - ;; For read-only bind mounts, an extra remount is - ;; needed, as per <http://lwn.net/Articles/281157/>, - ;; which still applies to Linux 4.0. - (when (and (= MS_BIND (logand flags MS_BIND)) - (= MS_RDONLY (logand flags MS_RDONLY))) - (mount device #$target #$type - (logior MS_BIND MS_REMOUNT MS_RDONLY)))) + #$(if create? + #~(mkdir-p #$target) + #t) + (mount-file-system + `(#$device #$title #$target #$type #$flags #$options + #$check?) #:root "/") #t)) (stop #~(lambda args ;; Normally there are no processes left at this point, so @@ -305,7 +285,7 @@ FILE-SYSTEM." ;; We need an additional module. (modules `(((gnu build file-systems) - #:select (check-file-system canonicalize-device-spec)) + #:select (mount-file-system)) ,@%default-modules))))))) (define file-system-service-type diff --git a/gnu/services/configuration.scm b/gnu/services/configuration.scm index 9f28aabc96..94c5f21557 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/cups.scm b/gnu/services/cups.scm index 391046a75f..df1843e438 100644 --- a/gnu/services/cups.scm +++ b/gnu/services/cups.scm @@ -894,7 +894,7 @@ IPP specifications.") (if (file-exists? dst) (format (current-error-port) "warning: ~a exists\n" dst) (symlink src dst)))) - (find-files (string-append package path)))) + (find-files (string-append package path) #:stat stat))) (list #$@paths))) (list #$@packages)) #t)))) diff --git a/gnu/services/kerberos.scm b/gnu/services/kerberos.scm index a56f63082c..cb33a7c53d 100644 --- a/gnu/services/kerberos.scm +++ b/gnu/services/kerberos.scm @@ -17,14 +17,388 @@ ;;; 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)) + + + +(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) + (unless (eq? val unset-field) + (serialize-field* field-name val))) + +(define (serialize-integer/unset field-name val) + (unless (eq? val unset-field) + (serialize-field* field-name val))) + +(define (serialize-boolean/unset field-name val) + (unless (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 ("foobar.example.com" . 109) +(define (end-point? val) + (match val + ((? string?) #t) + (((? string?) . (? integer?)) #t) + (_ #f))) + +(define (serialize-end-point field-name val) + (serialize-field* field-name + (match val + ((host . port) + ;; The [] are needed in the case of IPv6 addresses + (format #f "[~a]:~a" host port)) + (host + (format #f "~a" host))))) + +(define (serialize-space-separated-string-list/unset field-name val) + (unless (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) + (unless (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) + (unless (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) + (unless (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)) + + + +;; 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))))) + + + (define-record-type* <pam-krb5-configuration> pam-krb5-configuration make-pam-krb5-configuration |