ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-25 22:08:16 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

Remove "guile-zlib" extension when unused.

Browse source 
This is a follow-up of 755f365b02.

As (zlib) is autoloaded in (gnu build linux-modules), "guile-zlib" is needed
as an extension only when it is effectively used.

* gnu/installer.scm (installer-program): Remove "guile-zlib" from the extensions.
* gnu/machine/ssh.scm (machine-check-initrd-modules): Ditto.
* gnu/services.scm (activation-script): Ditto.
* gnu/services/base.scm (default-serial-port): Ditto,
(agetty-shepherd-service): ditto,
(udev-service-type): ditto.
* gnu/system/image.scm (gcrypt-sqlite3&co): Ditto.
* gnu/system/shadow.scm (account-shepherd-service): Ditto.
This commit is contained in:
Mathieu Othacehe 2020-08-25 12:39:11 +02:00
parent 5fe12be0dd
commit dac7dd1b0b
No known key found for this signature in database
GPG key ID: 8354763531769CA6
6 changed files with 243 additions and 259 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
gnu/installer.scm
View file

@ -342,8 +342,7 @@ (define installer-builder
;; packages …), etc. modules. ;; packages …), etc. modules.
(with-extensions (list guile-gcrypt guile-newt (with-extensions (list guile-gcrypt guile-newt
guile-parted guile-bytestructures guile-parted guile-bytestructures
guile-json-3 guile-git guile-zlib guile-json-3 guile-git guix)
guix)
(with-imported-modules `(,@(source-module-closure (with-imported-modules `(,@(source-module-closure
`(,@modules `(,@modules
(gnu services herd) (gnu services herd)

31
gnu/machine/ssh.scm
View file

@ -21,7 +21,6 @@ (define-module (gnu machine ssh)
#:use-module (gnu bootloader) #:use-module (gnu bootloader)
#:use-module (gnu machine) #:use-module (gnu machine)
#:autoload (gnu packages gnupg) (guile-gcrypt) #:autoload (gnu packages gnupg) (guile-gcrypt)
#:autoload (gnu packages guile) (guile-zlib)
#:use-module (gnu system) #:use-module (gnu system)
#:use-module (gnu system file-systems) #:use-module (gnu system file-systems)
#:use-module (gnu system uuid) #:use-module (gnu system uuid)
@ -249,24 +248,22 @@ (define remote-exp
'((gnu build file-systems) '((gnu build file-systems)
(gnu build linux-modules) (gnu build linux-modules)
(gnu system uuid))) (gnu system uuid)))
(with-extensions (list guile-zlib) #~(begin
#~(begin (use-modules (gnu build file-systems)
(use-modules (gnu build file-systems) (gnu build linux-modules)
(gnu build linux-modules) (gnu system uuid))
(gnu system uuid))
(define dev (define dev
#$(cond ((string? device) device) #$(cond ((string? device) device)
((uuid? device) #~(find-partition-by-uuid ((uuid? device) #~(find-partition-by-uuid
(string->uuid (string->uuid
#$(uuid->string device)))) #$(uuid->string device))))
((file-system-label? device) ((file-system-label? device)
#~(find-partition-by-label #~(find-partition-by-label
#$(file-system-label->string device))))) #$(file-system-label->string device)))))
(missing-modules dev (missing-modules dev '#$(operating-system-initrd-modules
'#$(operating-system-initrd-modules (machine-operating-system machine)))))))
(machine-operating-system machine))))))))
(remote-let ((missing remote-exp)) (remote-let ((missing remote-exp))
(unless (null? missing) (unless (null? missing)

38
gnu/services.scm
View file

@ -35,7 +35,6 @@ (define-module (gnu services)
#:use-module (guix modules) #:use-module (guix modules)
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages guile)
#:use-module (gnu packages hurd) #:use-module (gnu packages hurd)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
@ -586,29 +585,28 @@ (define actions
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
'((gnu build activation) '((gnu build activation)
(guix build utils))) (guix build utils)))
(with-extensions (list guile-zlib) #~(begin
#~(begin (use-modules (gnu build activation)
(use-modules (gnu build activation) (guix build utils))
(guix build utils))
;; Make sure the user accounting database exists. If ;; Make sure the user accounting database exists. If it
;; it does not exist, 'setutxent' does not create it ;; does not exist, 'setutxent' does not create it and
;; and thus there is no accounting at all. ;; thus there is no accounting at all.
(close-port (open-file "/var/run/utmpx" "a0")) (close-port (open-file "/var/run/utmpx" "a0"))
;; Same for 'wtmp', which is populated by mingetty et ;; Same for 'wtmp', which is populated by mingetty et
;; al. ;; al.
(mkdir-p "/var/log") (mkdir-p "/var/log")
(close-port (open-file "/var/log/wtmp" "a0")) (close-port (open-file "/var/log/wtmp" "a0"))
;; Set up /run/current-system. Among other things ;; Set up /run/current-system. Among other things this
;; this sets up locales, which the activation snippets ;; sets up locales, which the activation snippets
;; executed below may expect. ;; executed below may expect.
(activate-current-system) (activate-current-system)
;; Run the services' activation snippets. ;; Run the services' activation snippets.
;; TODO: Use 'load-compiled'. ;; TODO: Use 'load-compiled'.
(for-each primitive-load '#$actions)))))) (for-each primitive-load '#$actions)))))
(define (gexps->activation-gexp gexps) (define (gexps->activation-gexp gexps)
"Return a gexp that runs the activation script containing GEXPS." "Return a gexp that runs the activation script containing GEXPS."

416
gnu/services/base.scm
View file

@ -50,7 +50,6 @@ (define-module (gnu services base)
#:select (coreutils glibc glibc-utf8-locales)) #:select (coreutils glibc glibc-utf8-locales))
#:use-module (gnu packages package-management) #:use-module (gnu packages package-management)
#:use-module ((gnu packages gnupg) #:select (guile-gcrypt)) #:use-module ((gnu packages gnupg) #:select (guile-gcrypt))
#:use-module ((gnu packages guile) #:select (guile-zlib))
#:use-module (gnu packages linux) #:use-module (gnu packages linux)
#:use-module (gnu packages terminals) #:use-module (gnu packages terminals)
#:use-module ((gnu build file-systems) #:use-module ((gnu build file-systems)
@ -837,38 +836,36 @@ (define (default-serial-port)
to use as the tty. This is primarily useful for headless systems." to use as the tty. This is primarily useful for headless systems."
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
'((gnu build linux-boot))) ;for 'find-long-options' '((gnu build linux-boot))) ;for 'find-long-options'
(with-extensions (list guile-zlib) #~(begin
#~(begin ;; console=device,options
;; console=device,options ;; device: can be tty0, ttyS0, lp0, ttyUSB0 (serial).
;; device: can be tty0, ttyS0, lp0, ttyUSB0 (serial). ;; options: BBBBPNF. P n|o|e, N number of bits,
;; options: BBBBPNF. P n|o|e, N number of bits, ;; F flow control (r RTS)
;; F flow control (r RTS) (let* ((not-comma (char-set-complement (char-set #\,)))
(let* ((not-comma (char-set-complement (char-set #\,))) (command (linux-command-line))
(command (linux-command-line)) (agetty-specs (find-long-options "agetty.tty" command))
(agetty-specs (find-long-options "agetty.tty" command)) (console-specs (filter (lambda (spec)
(console-specs (and (string-prefix? "tty" spec)
(filter (lambda (spec) (not (or
(and (string-prefix? "tty" spec) (string-prefix? "tty0" spec)
(not (or (string-prefix? "tty1" spec)
(string-prefix? "tty0" spec) (string-prefix? "tty2" spec)
(string-prefix? "tty1" spec) (string-prefix? "tty3" spec)
(string-prefix? "tty2" spec) (string-prefix? "tty4" spec)
(string-prefix? "tty3" spec) (string-prefix? "tty5" spec)
(string-prefix? "tty4" spec) (string-prefix? "tty6" spec)
(string-prefix? "tty5" spec) (string-prefix? "tty7" spec)
(string-prefix? "tty6" spec) (string-prefix? "tty8" spec)
(string-prefix? "tty7" spec) (string-prefix? "tty9" spec)))))
(string-prefix? "tty8" spec) (find-long-options "console" command)))
(string-prefix? "tty9" spec))))) (specs (append agetty-specs console-specs)))
(find-long-options "console" command))) (match specs
(specs (append agetty-specs console-specs))) (() #f)
(match specs ((spec _ ...)
(() #f) ;; Extract device name from first spec.
((spec _ ...) (match (string-tokenize spec not-comma)
;; Extract device name from first spec. ((device-name _ ...)
(match (string-tokenize spec not-comma) device-name))))))))
((device-name _ ...)
device-name)))))))))
(define agetty-shepherd-service (define agetty-shepherd-service
(match-lambda (match-lambda
@ -893,124 +890,122 @@ (define agetty-shepherd-service
(start (start
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
'((gnu build linux-boot))) '((gnu build linux-boot)))
(with-extensions (list guile-zlib) #~(lambda args
#~(lambda args (let ((defaulted-tty #$(or tty (default-serial-port))))
(let ((defaulted-tty #$(or tty (default-serial-port)))) (apply
(apply (if defaulted-tty
(if defaulted-tty (make-forkexec-constructor
(make-forkexec-constructor (list #$(file-append util-linux "/sbin/agetty")
(list #$(file-append util-linux "/sbin/agetty") #$@extra-options
#$@extra-options #$@(if eight-bits?
#$@(if eight-bits? #~("--8bits")
#~("--8bits") #~())
#~()) #$@(if no-reset?
#$@(if no-reset? #~("--noreset")
#~("--noreset") #~())
#~()) #$@(if remote?
#$@(if remote? #~("--remote")
#~("--remote") #~())
#~()) #$@(if flow-control?
#$@(if flow-control? #~("--flow-control")
#~("--flow-control") #~())
#~()) #$@(if host
#$@(if host #~("--host" #$host)
#~("--host" #$host) #~())
#~()) #$@(if no-issue?
#$@(if no-issue? #~("--noissue")
#~("--noissue") #~())
#~()) #$@(if init-string
#$@(if init-string #~("--init-string" #$init-string)
#~("--init-string" #$init-string) #~())
#~()) #$@(if no-clear?
#$@(if no-clear? #~("--noclear")
#~("--noclear") #~())
#~()) ;;; FIXME This doesn't work as expected. According to agetty(8), if this option
;;; FIXME This doesn't work as expected. According to agetty(8), if this ;;; is not passed, then the default is 'auto'. However, in my tests, when that
;;; option is not passed, then the default is 'auto'. However, in my tests, ;;; option is selected, agetty never presents the login prompt, and the
;;; when that option is selected, agetty never presents the login prompt, and ;;; term-ttyS0 service respawns every few seconds.
;;; the term-ttyS0 service respawns every few seconds. #$@(if local-line
#$@(if local-line #~(#$(match local-line
#~(#$(match local-line ('auto "--local-line=auto")
('auto "--local-line=auto") ('always "--local-line=always")
('always "--local-line=always") ('never "-local-line=never")))
('never "-local-line=never"))) #~())
#~()) #$@(if tty
#$@(if tty #~()
#~() #~("--keep-baud"))
#~("--keep-baud")) #$@(if extract-baud?
#$@(if extract-baud? #~("--extract-baud")
#~("--extract-baud") #~())
#~()) #$@(if skip-login?
#$@(if skip-login? #~("--skip-login")
#~("--skip-login") #~())
#~()) #$@(if no-newline?
#$@(if no-newline? #~("--nonewline")
#~("--nonewline") #~())
#~()) #$@(if login-options
#$@(if login-options #~("--login-options" #$login-options)
#~("--login-options" #$login-options) #~())
#~()) #$@(if chroot
#$@(if chroot #~("--chroot" #$chroot)
#~("--chroot" #$chroot) #~())
#~()) #$@(if hangup?
#$@(if hangup? #~("--hangup")
#~("--hangup") #~())
#~()) #$@(if keep-baud?
#$@(if keep-baud? #~("--keep-baud")
#~("--keep-baud") #~())
#~()) #$@(if timeout
#$@(if timeout #~("--timeout" #$(number->string timeout))
#~("--timeout" #~())
#$(number->string timeout)) #$@(if detect-case?
#~()) #~("--detect-case")
#$@(if detect-case? #~())
#~("--detect-case") #$@(if wait-cr?
#~()) #~("--wait-cr")
#$@(if wait-cr? #~())
#~("--wait-cr") #$@(if no-hints?
#~()) #~("--nohints?")
#$@(if no-hints? #~())
#~("--nohints?") #$@(if no-hostname?
#~()) #~("--nohostname")
#$@(if no-hostname? #~())
#~("--nohostname") #$@(if long-hostname?
#~()) #~("--long-hostname")
#$@(if long-hostname? #~())
#~("--long-hostname") #$@(if erase-characters
#~()) #~("--erase-chars" #$erase-characters)
#$@(if erase-characters #~())
#~("--erase-chars" #$erase-characters) #$@(if kill-characters
#~()) #~("--kill-chars" #$kill-characters)
#$@(if kill-characters #~())
#~("--kill-chars" #$kill-characters) #$@(if chdir
#~()) #~("--chdir" #$chdir)
#$@(if chdir #~())
#~("--chdir" #$chdir) #$@(if delay
#~()) #~("--delay" #$(number->string delay))
#$@(if delay #~())
#~("--delay" #$(number->string delay)) #$@(if nice
#~()) #~("--nice" #$(number->string nice))
#$@(if nice #~())
#~("--nice" #$(number->string nice)) #$@(if auto-login
#~()) (list "--autologin" auto-login)
#$@(if auto-login '())
(list "--autologin" auto-login) #$@(if login-program
'()) #~("--login-program" #$login-program)
#$@(if login-program #~())
#~("--login-program" #$login-program) #$@(if login-pause?
#~()) #~("--login-pause")
#$@(if login-pause? #~())
#~("--login-pause") defaulted-tty
#~()) #$@(if baud-rate
defaulted-tty #~(#$baud-rate)
#$@(if baud-rate #~())
#~(#$baud-rate) #$@(if term
#~()) #~(#$term)
#$@(if term #~())))
#~(#$term) (const #f)) ; never start.
#~()))) args)))))
(const #f)) ; never start.
args))))))
(stop #~(make-kill-destructor))))))) (stop #~(make-kill-destructor)))))))
(define agetty-service-type (define agetty-service-type
@ -1944,73 +1939,70 @@ (define udev-shepherd-service
(start (start
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
'((gnu build linux-boot))) '((gnu build linux-boot)))
(with-extensions (list guile-zlib) #~(lambda ()
#~(lambda () (define udevd
(define udevd ;; 'udevd' from eudev.
;; 'udevd' from eudev. #$(file-append udev "/sbin/udevd"))
#$(file-append udev "/sbin/udevd"))
(define (wait-for-udevd) (define (wait-for-udevd)
;; Wait until someone's listening on udevd's control ;; Wait until someone's listening on udevd's control
;; socket. ;; socket.
(let ((sock (socket AF_UNIX SOCK_SEQPACKET 0))) (let ((sock (socket AF_UNIX SOCK_SEQPACKET 0)))
(let try () (let try ()
(catch 'system-error (catch 'system-error
(lambda () (lambda ()
(connect sock PF_UNIX "/run/udev/control") (connect sock PF_UNIX "/run/udev/control")
(close-port sock)) (close-port sock))
(lambda args (lambda args
(format #t "waiting for udevd...~%") (format #t "waiting for udevd...~%")
(usleep 500000) (usleep 500000)
(try)))))) (try))))))
;; Allow udev to find the modules. ;; Allow udev to find the modules.
(setenv "LINUX_MODULE_DIRECTORY" (setenv "LINUX_MODULE_DIRECTORY"
"/run/booted-system/kernel/lib/modules") "/run/booted-system/kernel/lib/modules")
(let* ((kernel-release (let* ((kernel-release
(utsname:release (uname))) (utsname:release (uname)))
(linux-module-directory (linux-module-directory
(getenv "LINUX_MODULE_DIRECTORY")) (getenv "LINUX_MODULE_DIRECTORY"))
(directory (directory
(string-append linux-module-directory "/" (string-append linux-module-directory "/"
kernel-release)) kernel-release))
(old-umask (umask #o022))) (old-umask (umask #o022)))
;; If we're in a container, DIRECTORY might not exist, ;; If we're in a container, DIRECTORY might not exist,
;; for instance because the host runs a different ;; for instance because the host runs a different
;; kernel. In that case, skip it; we'll just miss a few ;; kernel. In that case, skip it; we'll just miss a few
;; nodes like /dev/fuse. ;; nodes like /dev/fuse.
(when (file-exists? directory) (when (file-exists? directory)
(make-static-device-nodes directory)) (make-static-device-nodes directory))
(umask old-umask)) (umask old-umask))
(let ((pid (let ((pid (fork+exec-command (list udevd)
(fork+exec-command #:environment-variables
(list udevd) (cons*
#:environment-variables ;; The first one is for udev, the second one for
(cons* ;; eudev.
;; The first one is for udev, the second one for (string-append "UDEV_CONFIG_FILE=" #$udev.conf)
;; eudev. (string-append "EUDEV_RULES_DIRECTORY="
(string-append "UDEV_CONFIG_FILE=" #$udev.conf) #$(file-append
(string-append "EUDEV_RULES_DIRECTORY=" rules "/lib/udev/rules.d"))
#$(file-append (string-append "LINUX_MODULE_DIRECTORY="
rules "/lib/udev/rules.d")) (getenv "LINUX_MODULE_DIRECTORY"))
(string-append "LINUX_MODULE_DIRECTORY=" (default-environment-variables)))))
(getenv "LINUX_MODULE_DIRECTORY")) ;; Wait until udevd is up and running. This appears to
(default-environment-variables))))) ;; be needed so that the events triggered below are
;; Wait until udevd is up and running. This appears to ;; actually handled.
;; be needed so that the events triggered below are (wait-for-udevd)
;; actually handled.
(wait-for-udevd)
;; Trigger device node creation. ;; Trigger device node creation.
(system* #$(file-append udev "/bin/udevadm") (system* #$(file-append udev "/bin/udevadm")
"trigger" "--action=add") "trigger" "--action=add")
;; Wait for things to settle down. ;; Wait for things to settle down.
(system* #$(file-append udev "/bin/udevadm") (system* #$(file-append udev "/bin/udevadm")
"settle") "settle")
pid))))) pid))))
(stop #~(make-kill-destructor)) (stop #~(make-kill-destructor))
;; When halting the system, 'udev' is actually killed by ;; When halting the system, 'udev' is actually killed by

2
gnu/system/image.scm
View file

@ -141,7 +141,7 @@ (define gcrypt-sqlite3&co
(match (package-transitive-propagated-inputs package) (match (package-transitive-propagated-inputs package)
(((labels packages) ...) (((labels packages) ...)
packages)))) packages))))
(list guile-gcrypt guile-sqlite3 guile-zlib))) (list guile-gcrypt guile-sqlite3)))
(define-syntax-rule (with-imported-modules* gexp* ...) (define-syntax-rule (with-imported-modules* gexp* ...)
(with-extensions gcrypt-sqlite3&co (with-extensions gcrypt-sqlite3&co

12
gnu/system/shadow.scm
View file

@ -34,7 +34,6 @@ (define-module (gnu system shadow)
#:use-module ((gnu packages admin) #:use-module ((gnu packages admin)
#:select (shadow)) #:select (shadow))
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages guile)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
@ -325,12 +324,11 @@ (define accounts
(start (with-imported-modules (source-module-closure (start (with-imported-modules (source-module-closure
'((gnu build activation) '((gnu build activation)
(gnu system accounts))) (gnu system accounts)))
(with-extensions (list guile-zlib) #~(lambda ()
#~(lambda () (activate-user-home
(activate-user-home (map sexp->user-account
(map sexp->user-account (list #$@(map user-account->gexp accounts))))
(list #$@(map user-account->gexp accounts)))) #t))) ;success
#t)))) ;success
(documentation "Create user home directories.")))) (documentation "Create user home directories."))))
(define (shells-file shells) (define (shells-file shells)