ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-12 22:26:40 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

offload: Autoload Guile-SSH.

Browse source 
This halves the number of syscalls made by "guix offload" during startup
and delays loading of Guile-SSH until there are actually machines to
offload to.

* guix/scripts/offload.scm: Remove unused module imports.  Autoload many
modules.
(check-ssh-zlib-support): New procedure.
(process-request): Call it when accepting.
(guix-offload): Remove 'zlib-support?' check, now moved to
'check-ssh-zlib-support'.
This commit is contained in:
Ludovic Courtès 2021-12-15 12:45:11 +01:00
parent ebbf7fc1c6
commit 2a621f168f
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 27 additions and 20 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

47
guix/scripts/offload.scm
View file

@ -20,21 +20,26 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (guix scripts offload) (define-module (guix scripts offload)
#:use-module (ssh key) #:autoload (ssh key) (private-key-from-file
#:use-module (ssh auth) public-key-from-file)
#:use-module (ssh session) #:autoload (ssh auth) (userauth-public-key!)
#:use-module (ssh channel) #:autoload (ssh session) (make-session
#:use-module (ssh popen) connect! get-error
#:use-module (ssh version) disconnect! session-set!)
#:autoload (ssh version) (zlib-support?)
#:use-module (guix config) #:use-module (guix config)
#:use-module (guix records) #:use-module (guix records)
#:use-module (guix ssh) #:autoload (guix ssh) (authenticate-server*
connect-to-remote-daemon
send-files retrieve-files retrieve-files*
remote-inferior report-guile-error)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix inferior) #:autoload (guix inferior) (inferior-eval close-inferior inferior?)
#:use-module (guix derivations) #:autoload (guix derivations) (read-derivation-from-file
#:use-module ((guix serialization) derivation-file-name
#:select (nar-error? nar-error-file)) build-derivations)
#:use-module (guix nar) #:autoload (guix serialization) (nar-error? nar-error-file)
#:autoload (guix nar) (restore-file-set)
#:use-module ((guix utils) #:select (%current-system)) #:use-module ((guix utils) #:select (%current-system))
#:use-module ((guix build syscalls) #:use-module ((guix build syscalls)
#:select (fcntl-flock set-thread-name)) #:select (fcntl-flock set-thread-name))
@ -47,12 +52,10 @@ (define-module (guix scripts offload)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
#:use-module (srfi srfi-35) #:use-module (srfi srfi-35)
#:use-module (ice-9 popen)
#:use-module (ice-9 rdelim) #:use-module (ice-9 rdelim)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 regex) #:use-module (ice-9 regex)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:use-module (ice-9 binary-ports)
#:export (build-machine #:export (build-machine
build-machine? build-machine?
build-machine-name build-machine-name
@ -560,6 +563,15 @@ (define-syntax-rule (with-timeout timeout drv exp ...)
If TIMEOUT is #f, simply evaluate EXP..." If TIMEOUT is #f, simply evaluate EXP..."
(call-with-timeout timeout drv (lambda () exp ...))) (call-with-timeout timeout drv (lambda () exp ...)))
(define (check-ssh-zlib-support)
"Warn once if libssh lacks zlib support."
;; We rely on protocol-level compression from libssh to optimize large data
;; transfers. Warn if it's missing.
(unless (zlib-support?)
(warning (G_ "Guile-SSH lacks zlib support"))
(warning (G_ "data transfers will *not* be compressed!")))
(set! check-ssh-zlib-support (const #t)))
(define* (process-request wants-local? system drv features (define* (process-request wants-local? system drv features
#:key #:key
print-build-trace? (max-silent-time 3600) print-build-trace? (max-silent-time 3600)
@ -584,6 +596,7 @@ (define* (process-request wants-local? system drv features
(lambda () (lambda ()
;; Offload DRV to MACHINE. ;; Offload DRV to MACHINE.
(display "# accept\n") (display "# accept\n")
(check-ssh-zlib-support)
(let ((drv (read-derivation-from-file drv)) (let ((drv (read-derivation-from-file drv))
(inputs (string-tokenize (read-line))) (inputs (string-tokenize (read-line)))
(outputs (string-tokenize (read-line)))) (outputs (string-tokenize (read-line))))
@ -783,12 +796,6 @@ (define not-coma
(and=> (passwd:dir (getpw (getuid))) (and=> (passwd:dir (getpw (getuid)))
(cut setenv "HOME" <>)) (cut setenv "HOME" <>))
;; We rely on protocol-level compression from libssh to optimize large data
;; transfers. Warn if it's missing.
(unless (zlib-support?)
(warning (G_ "Guile-SSH lacks zlib support"))
(warning (G_ "data transfers will *not* be compressed!")))
(match args (match args
((system max-silent-time print-build-trace? build-timeout) ((system max-silent-time print-build-trace? build-timeout)
(let ((max-silent-time (string->number max-silent-time)) (let ((max-silent-time (string->number max-silent-time))