gnu: docker: Optimize substitution macros.
This change halves the time needed to patch the paths.
* gnu/packages/docker.scm (docker)[phases]{patch-paths}: Allow passing
multiple SOURCE-TEXT, PACKAGE and RELATIVE-PATH tuples so that the rewrite
rules can be generated and processed by a single use of the SUBSTITUTE*
macro. Rename SUBSTITUTE-LOOKPATH to SUBSTITUTE-LOOKPATH* and
substitute-Command to SUBSTITUTE-COMMAND* to denote the change. Adapt the
uses of SUBSTITUTE-LOOKPATH* and SUBSTITUTE-COMMAND*.
master
Maxim Cournoyer
parent
079f0eb3d2
commit
a01d54f3bd
|
|
@ -366,68 +366,66 @@ built-in registry server of Docker.")
|
||||||
(let ((source-files (filter (lambda (name)
|
(let ((source-files (filter (lambda (name)
|
||||||
(not (string-contains name "test")))
|
(not (string-contains name "test")))
|
||||||
(find-files "." "\\.go$"))))
|
(find-files "." "\\.go$"))))
|
||||||
(let-syntax ((substitute-LookPath
|
(let-syntax ((substitute-LookPath*
|
||||||
(lambda (x)
|
(syntax-rules ()
|
||||||
(syntax-case x ()
|
((_ (source-text package relative-path) ...)
|
||||||
((substitute-LookPath source-text package
|
(substitute* source-files
|
||||||
relative-path)
|
(((string-append "\\<exec\\.LookPath\\(\""
|
||||||
#`(substitute* source-files
|
source-text
|
||||||
((#,(string-append "\\<exec\\.LookPath\\(\""
|
"\")"))
|
||||||
(syntax->datum
|
(string-append "\""
|
||||||
#'source-text)
|
(assoc-ref inputs package)
|
||||||
"\")"))
|
"/" relative-path
|
||||||
(string-append "\""
|
"\", error(nil)")) ...))))
|
||||||
(assoc-ref inputs package)
|
(substitute-Command*
|
||||||
"/" relative-path
|
(syntax-rules ()
|
||||||
"\", error(nil)")))))))
|
((_ (source-text package relative-path) ...)
|
||||||
(substitute-Command
|
(substitute* source-files
|
||||||
(lambda (x)
|
(((string-append "\\<(re)?exec\\.Command\\(\""
|
||||||
(syntax-case x ()
|
source-text
|
||||||
((substitute-LookPath source-text package
|
"\"") _ re?)
|
||||||
relative-path)
|
(string-append (if re? re? "")
|
||||||
#`(substitute* source-files
|
"exec.Command(\""
|
||||||
((#,(string-append "\\<(re)?exec\\.Command\\(\""
|
(assoc-ref inputs package)
|
||||||
(syntax->datum
|
"/" relative-path
|
||||||
#'source-text)
|
"\"")) ...)))))
|
||||||
"\"") _ re?)
|
(substitute-LookPath*
|
||||||
(string-append (if re? re? "")
|
("ps" "procps" "bin/ps")
|
||||||
"exec.Command(\""
|
("mkfs.xfs" "xfsprogs" "bin/mkfs.xfs")
|
||||||
(assoc-ref inputs package)
|
("lvmdiskscan" "lvm2" "sbin/lvmdiskscan")
|
||||||
"/" relative-path
|
("pvdisplay" "lvm2" "sbin/pvdisplay")
|
||||||
"\""))))))))
|
("blkid" "util-linux" "sbin/blkid")
|
||||||
(substitute-LookPath "ps" "procps" "bin/ps")
|
("unpigz" "pigz" "bin/unpigz")
|
||||||
(substitute-LookPath "mkfs.xfs" "xfsprogs" "bin/mkfs.xfs")
|
("iptables" "iptables" "sbin/iptables")
|
||||||
(substitute-LookPath "lvmdiskscan" "lvm2" "sbin/lvmdiskscan")
|
("iptables-legacy" "iptables" "sbin/iptables")
|
||||||
(substitute-LookPath "pvdisplay" "lvm2" "sbin/pvdisplay")
|
("ip" "iproute2" "sbin/ip"))
|
||||||
(substitute-LookPath "blkid" "util-linux" "sbin/blkid")
|
|
||||||
(substitute-LookPath "unpigz" "pigz" "bin/unpigz")
|
(substitute-Command*
|
||||||
(substitute-LookPath "iptables" "iptables" "sbin/iptables")
|
("modprobe" "kmod" "bin/modprobe")
|
||||||
(substitute-LookPath "iptables-legacy" "iptables" "sbin/iptables")
|
("pvcreate" "lvm2" "sbin/pvcreate")
|
||||||
(substitute-LookPath "ip" "iproute2" "sbin/ip")
|
("vgcreate" "lvm2" "sbin/vgcreate")
|
||||||
(substitute-Command "modprobe" "kmod" "bin/modprobe")
|
("lvcreate" "lvm2" "sbin/lvcreate")
|
||||||
(substitute-Command "pvcreate" "lvm2" "sbin/pvcreate")
|
("lvconvert" "lvm2" "sbin/lvconvert")
|
||||||
(substitute-Command "vgcreate" "lvm2" "sbin/vgcreate")
|
("lvchange" "lvm2" "sbin/lvchange")
|
||||||
(substitute-Command "lvcreate" "lvm2" "sbin/lvcreate")
|
("mkfs.xfs" "xfsprogs" "sbin/mkfs.xfs")
|
||||||
(substitute-Command "lvconvert" "lvm2" "sbin/lvconvert")
|
("xfs_growfs" "xfsprogs" "sbin/xfs_growfs")
|
||||||
(substitute-Command "lvchange" "lvm2" "sbin/lvchange")
|
("mkfs.ext4" "e2fsprogs" "sbin/mkfs.ext4")
|
||||||
(substitute-Command "mkfs.xfs" "xfsprogs" "sbin/mkfs.xfs")
|
("tune2fs" "e2fsprogs" "sbin/tune2fs")
|
||||||
(substitute-Command "xfs_growfs" "xfsprogs" "sbin/xfs_growfs")
|
("blkid" "util-linux" "sbin/blkid")
|
||||||
(substitute-Command "mkfs.ext4" "e2fsprogs" "sbin/mkfs.ext4")
|
("resize2fs" "e2fsprogs" "sbin/resize2fs")
|
||||||
(substitute-Command "tune2fs" "e2fsprogs" "sbin/tune2fs")
|
("ps" "procps" "bin/ps")
|
||||||
(substitute-Command "blkid" "util-linux" "sbin/blkid")
|
("losetup" "util-linux" "sbin/losetup")
|
||||||
(substitute-Command "resize2fs" "e2fsprogs" "sbin/resize2fs")
|
("uname" "coreutils" "bin/uname")
|
||||||
;; docker-mountfrom ??
|
("dbus-launch" "dbus" "bin/dbus-launch")
|
||||||
;; docker
|
("git" "git" "bin/git")))
|
||||||
;; docker-untar ??
|
;; docker-mountfrom ??
|
||||||
;; docker-applyLayer ??
|
;; docker
|
||||||
;; /usr/bin/uname
|
;; docker-untar ??
|
||||||
;; grep
|
;; docker-applyLayer ??
|
||||||
;; apparmor_parser
|
;; /usr/bin/uname
|
||||||
(substitute-Command "ps" "procps" "bin/ps")
|
;; grep
|
||||||
(substitute-Command "losetup" "util-linux" "sbin/losetup")
|
;; apparmor_parser
|
||||||
(substitute-Command "uname" "coreutils" "bin/uname")
|
|
||||||
(substitute-Command "dbus-launch" "dbus" "bin/dbus-launch")
|
|
||||||
(substitute-Command "git" "git" "bin/git"))
|
|
||||||
;; Make compilation fail when, in future versions, Docker
|
;; Make compilation fail when, in future versions, Docker
|
||||||
;; invokes other programs we don't know about and thus don't
|
;; invokes other programs we don't know about and thus don't
|
||||||
;; substitute.
|
;; substitute.
|
||||||
|
|
|
||||||
Reference in New Issue