From 4ca3e9b7b6909839c3b03f691a1c370e3fdea3b0 Mon Sep 17 00:00:00 2001 From: Clément Lassieur Date: Sat, 18 Mar 2017 11:17:57 +0100 Subject: services: openssh: Cosmetic changes. * gnu/services/ssh.scm (): Reformat to fit in 80 columns. --- gnu/services/ssh.scm | 31 +++++++++++++++++++++---------- 1 file changed, 21 insertions(+), 10 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm index d8a3ad35ad..6272d53fc8 100644 --- a/gnu/services/ssh.scm +++ b/gnu/services/ssh.scm @@ -260,28 +260,39 @@ The other options should be self-descriptive." (define-record-type* openssh-configuration make-openssh-configuration openssh-configuration? - (openssh openssh-configuration-openssh ;package + ;; + (openssh openssh-configuration-openssh (default openssh)) + ;; string (pid-file openssh-configuration-pid-file (default "/var/run/sshd.pid")) - (port-number openssh-configuration-port-number ;integer + ;; integer + (port-number openssh-configuration-port-number (default 22)) - (permit-root-login openssh-configuration-permit-root-login ;Boolean | 'without-password + ;; Boolean | 'without-password + (permit-root-login openssh-configuration-permit-root-login (default #f)) - (allow-empty-passwords? openssh-configuration-allow-empty-passwords? ;Boolean + ;; Boolean + (allow-empty-passwords? openssh-configuration-allow-empty-passwords? (default #f)) - (password-authentication? openssh-configuration-password-authentication? ;Boolean + ;; Boolean + (password-authentication? openssh-configuration-password-authentication? (default #t)) + ;; Boolean (public-key-authentication? openssh-configuration-public-key-authentication? - (default #t)) ;Boolean - (x11-forwarding? openssh-configuration-x11-forwarding? ;Boolean + (default #t)) + ;; Boolean + (x11-forwarding? openssh-configuration-x11-forwarding? (default #f)) + ;; Boolean (challenge-response-authentication? openssh-challenge-response-authentication? - (default #f)) ;Boolean + (default #f)) + ;; Boolean (use-pam? openssh-configuration-use-pam? - (default #t)) ;Boolean + (default #t)) + ;; Boolean (print-last-log? openssh-configuration-print-last-log? - (default #t))) ;Boolean + (default #t))) (define %openssh-accounts (list (user-group (name "sshd") (system? #t)) -- cgit v1.2.3 From 12723370e5a780b18eae4c44ab9634adaff927ea Mon Sep 17 00:00:00 2001 From: Clément Lassieur Date: Tue, 21 Feb 2017 00:53:55 +0100 Subject: services: openssh: Add 'subsystems' option. * gnu/services/ssh.scm (openssh-config-file): Add it. ()[subsystems]: Add it. * doc/guix.texi (Networking Services): Document it. --- doc/guix.texi | 16 +++++++++++ gnu/services/ssh.scm | 81 +++++++++++++++++++++++++++++----------------------- 2 files changed, 62 insertions(+), 35 deletions(-) (limited to 'gnu/services') diff --git a/doc/guix.texi b/doc/guix.texi index 297141288c..8d27dd2031 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -9511,6 +9511,22 @@ equivalent role to password authentication, you should disable either @item @code{print-last-log?} (default: @code{#t}) Specifies whether @command{sshd} should print the date and time of the last user login when a user logs in interactively. + +@item @code{subsystems} (default: @code{'(("sftp" "internal-sftp"))}) +Configures external subsystems (e.g. file transfer daemon). + +This is a list of two-element lists, each of which containing the +subsystem name and a command (with optional arguments) to execute upon +subsystem request. + +The command @command{internal-sftp} implements an in-process SFTP +server. Alternately, one can specify the @command{sftp-server} command: +@example +(service openssh-service-type + (openssh-configuration + (subsystems + '(("sftp" ,(file-append openssh "/libexec/sftp-server")))))) +@end example @end table @end deftp diff --git a/gnu/services/ssh.scm b/gnu/services/ssh.scm index 6272d53fc8..b7f9887b30 100644 --- a/gnu/services/ssh.scm +++ b/gnu/services/ssh.scm @@ -292,7 +292,10 @@ The other options should be self-descriptive." (default #t)) ;; Boolean (print-last-log? openssh-configuration-print-last-log? - (default #t))) + (default #t)) + ;; list of two-element lists + (subsystems openssh-configuration-subsystems + (default '(("sftp" "internal-sftp"))))) (define %openssh-accounts (list (user-group (name "sshd") (system? #t)) @@ -327,40 +330,48 @@ The other options should be self-descriptive." "Return the sshd configuration file corresponding to CONFIG." (computed-file "sshd_config" - #~(call-with-output-file #$output - (lambda (port) - (display "# Generated by 'openssh-service'.\n" port) - (format port "Port ~a\n" - #$(number->string (openssh-configuration-port-number config))) - (format port "PermitRootLogin ~a\n" - #$(match (openssh-configuration-permit-root-login config) - (#t "yes") - (#f "no") - ('without-password "without-password"))) - (format port "PermitEmptyPasswords ~a\n" - #$(if (openssh-configuration-allow-empty-passwords? config) - "yes" "no")) - (format port "PasswordAuthentication ~a\n" - #$(if (openssh-configuration-password-authentication? config) - "yes" "no")) - (format port "PubkeyAuthentication ~a\n" - #$(if (openssh-configuration-public-key-authentication? config) - "yes" "no")) - (format port "X11Forwarding ~a\n" - #$(if (openssh-configuration-x11-forwarding? config) - "yes" "no")) - (format port "PidFile ~a\n" - #$(openssh-configuration-pid-file config)) - (format port "ChallengeResponseAuthentication ~a\n" - #$(if (openssh-challenge-response-authentication? config) - "yes" "no")) - (format port "UsePAM ~a\n" - #$(if (openssh-configuration-use-pam? config) - "yes" "no")) - (format port "PrintLastLog ~a\n" - #$(if (openssh-configuration-print-last-log? config) - "yes" "no")) - #t)))) + #~(begin + (use-modules (ice-9 match)) + (call-with-output-file #$output + (lambda (port) + (display "# Generated by 'openssh-service'.\n" port) + (format port "Port ~a\n" + #$(number->string + (openssh-configuration-port-number config))) + (format port "PermitRootLogin ~a\n" + #$(match (openssh-configuration-permit-root-login config) + (#t "yes") + (#f "no") + ('without-password "without-password"))) + (format port "PermitEmptyPasswords ~a\n" + #$(if (openssh-configuration-allow-empty-passwords? config) + "yes" "no")) + (format port "PasswordAuthentication ~a\n" + #$(if (openssh-configuration-password-authentication? config) + "yes" "no")) + (format port "PubkeyAuthentication ~a\n" + #$(if (openssh-configuration-public-key-authentication? + config) + "yes" "no")) + (format port "X11Forwarding ~a\n" + #$(if (openssh-configuration-x11-forwarding? config) + "yes" "no")) + (format port "PidFile ~a\n" + #$(openssh-configuration-pid-file config)) + (format port "ChallengeResponseAuthentication ~a\n" + #$(if (openssh-challenge-response-authentication? config) + "yes" "no")) + (format port "UsePAM ~a\n" + #$(if (openssh-configuration-use-pam? config) + "yes" "no")) + (format port "PrintLastLog ~a\n" + #$(if (openssh-configuration-print-last-log? config) + "yes" "no")) + (for-each + (match-lambda + ((name command) (format port "Subsystem\t~a\t~a\n" name command))) + '#$(openssh-configuration-subsystems config)) + #t))))) (define (openssh-shepherd-service config) "Return a for openssh with CONFIG." -- cgit v1.2.3 From 278d486b0c0e3ec0378f6a2ccf6946fb176d088b Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Tue, 21 Mar 2017 21:55:20 +0100 Subject: file-systems: Do not use (gnu packages …). MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Fixes a regression introduced in 7208995426714c9fc3ad59cadc3cc0f52df0f018 whereby (gnu system file-systems) would pull in (gnu packages …) module, which in turn breaks when importing things like (gnu build shepherd). * gnu/system/file-systems.scm (file-system-type-predicate): Export. (file-system-packages): Move to... * gnu/system/linux-initrd.scm (file-system-packages): ... here. Add docstring. * gnu/services/base.scm: Use it. * tests/file-systems.scm ("does not pull (gnu packages …)"): New test. --- gnu/services/base.scm | 2 ++ gnu/system/file-systems.scm | 27 +++++---------------------- gnu/system/linux-initrd.scm | 23 ++++++++++++++++++++++- tests/file-systems.scm | 12 +++++++++++- 4 files changed, 40 insertions(+), 24 deletions(-) (limited to 'gnu/services') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index dad1911d31..77efef15eb 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -31,6 +31,8 @@ #:use-module (gnu system shadow) ; 'user-account', etc. #:use-module (gnu system file-systems) ; 'file-system', etc. #:use-module (gnu system mapped-devices) + #:use-module ((gnu system linux-initrd) + #:select (file-system-packages)) #:use-module (gnu packages admin) #:use-module ((gnu packages linux) #:select (alsa-utils crda eudev e2fsprogs fuse gpm kbd lvm2 rng-tools)) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 8107722c74..3bd072a0bc 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -22,8 +22,6 @@ #:use-module (guix records) #:use-module ((gnu build file-systems) #:select (string->uuid uuid->string)) - #:use-module (gnu packages linux) - #:use-module (gnu packages disk) #:re-export (string->uuid uuid->string) #:export ( @@ -41,6 +39,8 @@ file-system-create-mount-point? file-system-dependencies + file-system-type-predicate + file-system->spec spec->file-system specification->file-system-mapping @@ -67,8 +67,6 @@ file-system-mapping->bind-mount - file-system-packages - %store-mapping %network-configuration-files %network-file-mappings)) @@ -77,6 +75,9 @@ ;;; ;;; Declaring file systems to be mounted. ;;; +;;; Note: this file system is used both in the Shepherd and on the "host +;;; side", so it must not include (gnu packages …) modules. +;;; ;;; Code: ;; File system declaration. @@ -419,22 +420,4 @@ a bind mount." (lambda (fs) (string=? (file-system-type fs) type))) -(define* (file-system-packages file-systems #:key (volatile-root? #f)) - `(,@(if (find (lambda (fs) - (string-prefix? "ext" (file-system-type fs))) - file-systems) - (list e2fsck/static) - '()) - ,@(if (find (lambda (fs) - (string-suffix? "fat" (file-system-type fs))) - file-systems) - (list fatfsck/static) - '()) - ,@(if (find (file-system-type-predicate "btrfs") file-systems) - (list btrfs-progs/static) - '()) - ,@(if volatile-root? - (list unionfs-fuse/static) - '()))) - ;;; file-systems.scm ends here diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index 1f1c306828..dfe198e43e 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016 Ludovic Courtès +;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès ;;; Copyright © 2016 Mark H Weaver ;;; Copyright © 2016 Jan Nieuwenhuizen ;;; Copyright © 2017 Mathieu Othacehe @@ -43,6 +43,7 @@ #:use-module (srfi srfi-26) #:export (expression->initrd raw-initrd + file-system-packages base-initrd)) @@ -199,6 +200,26 @@ to it are lost." #:volatile-root? '#$volatile-root?))) #:name "raw-initrd"))) +(define* (file-system-packages file-systems #:key (volatile-root? #f)) + "Return the list of statically-linked, stripped packages to check +FILE-SYSTEMS." + `(,@(if (find (lambda (fs) + (string-prefix? "ext" (file-system-type fs))) + file-systems) + (list e2fsck/static) + '()) + ,@(if (find (lambda (fs) + (string-suffix? "fat" (file-system-type fs))) + file-systems) + (list fatfsck/static) + '()) + ,@(if (find (file-system-type-predicate "btrfs") file-systems) + (list btrfs-progs/static) + '()) + ,@(if volatile-root? + (list unionfs-fuse/static) + '()))) + (define* (base-initrd file-systems #:key (linux linux-libre) diff --git a/tests/file-systems.scm b/tests/file-systems.scm index 467ee8ca5d..12f4f09c57 100644 --- a/tests/file-systems.scm +++ b/tests/file-systems.scm @@ -20,8 +20,10 @@ #:use-module (guix store) #:use-module (guix modules) #:use-module (gnu system file-systems) + #:use-module (srfi srfi-1) #:use-module (srfi srfi-64) - #:use-module (rnrs bytevectors)) + #:use-module (rnrs bytevectors) + #:use-module (ice-9 match)) ;; Test the (gnu system file-systems) module. @@ -80,4 +82,12 @@ (not (member '(guix config) (source-module-closure '((gnu system file-systems)))))) +(test-equal "does not pull (gnu packages …)" + ;; Same story: (gnu packages …) should not be pulled. + #f + (find (match-lambda + (('gnu 'packages _ ..1) #t) + (_ #f)) + (source-module-closure '((gnu system file-systems))))) + (test-end) -- cgit v1.2.3