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)

7
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,7 +248,6 @@ (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)
@ -264,9 +262,8 @@ (define dev
#~(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)

14
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,14 +585,13 @@ (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
@ -601,14 +599,14 @@ (define actions
(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."

28
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,7 +836,6 @@ (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).
@ -846,8 +844,7 @@ (define (default-serial-port)
(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 (console-specs (filter (lambda (spec)
(filter (lambda (spec)
(and (string-prefix? "tty" spec) (and (string-prefix? "tty" spec)
(not (or (not (or
(string-prefix? "tty0" spec) (string-prefix? "tty0" spec)
@ -868,7 +865,7 @@ (define (default-serial-port)
;; Extract device name from first spec. ;; Extract device name from first spec.
(match (string-tokenize spec not-comma) (match (string-tokenize spec not-comma)
((device-name _ ...) ((device-name _ ...)
device-name))))))))) device-name))))))))
(define agetty-shepherd-service (define agetty-shepherd-service
(match-lambda (match-lambda
@ -893,7 +890,6 @@ (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
@ -925,10 +921,10 @@ (define agetty-shepherd-service
#$@(if no-clear? #$@(if no-clear?
#~("--noclear") #~("--noclear")
#~()) #~())
;;; FIXME This doesn't work as expected. According to agetty(8), if this ;;; FIXME This doesn't work as expected. According to agetty(8), if this option
;;; option is not passed, then the default is 'auto'. However, in my tests, ;;; is not passed, then the default is 'auto'. However, in my tests, when that
;;; when that option is selected, agetty never presents the login prompt, and ;;; option is selected, agetty never presents the login prompt, and the
;;; the term-ttyS0 service respawns every few seconds. ;;; 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")
@ -960,8 +956,7 @@ (define agetty-shepherd-service
#~("--keep-baud") #~("--keep-baud")
#~()) #~())
#$@(if timeout #$@(if timeout
#~("--timeout" #~("--timeout" #$(number->string timeout))
#$(number->string timeout))
#~()) #~())
#$@(if detect-case? #$@(if detect-case?
#~("--detect-case") #~("--detect-case")
@ -1010,7 +1005,7 @@ (define agetty-shepherd-service
#~(#$term) #~(#$term)
#~()))) #~())))
(const #f)) ; never start. (const #f)) ; never start.
args)))))) args)))))
(stop #~(make-kill-destructor))))))) (stop #~(make-kill-destructor)))))))
(define agetty-service-type (define agetty-service-type
@ -1944,7 +1939,6 @@ (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.
@ -1984,9 +1978,7 @@ (define (wait-for-udevd)
(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
(list udevd)
#:environment-variables #:environment-variables
(cons* (cons*
;; The first one is for udev, the second one for ;; The first one is for udev, the second one for
@ -2010,7 +2002,7 @@ (define (wait-for-udevd)
;; 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

4
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)