Merge branch 'master' into staging
Brett Gilio
commit
94c7f70faa
|
|
@ -962,11 +962,8 @@ the URL: it is not very useful and if the name changes, the URL will probably
|
|||
be wrong.
|
||||
|
||||
@item
|
||||
See if Guix builds with
|
||||
@example
|
||||
guix environment --pure guix -- make
|
||||
@end example
|
||||
and look for warnings, especially those about use of undefined symbols.
|
||||
Check if Guix builds (@pxref{Building from Git}) and address the
|
||||
warnings, especially those about use of undefined symbols.
|
||||
|
||||
@item
|
||||
Make sure your changes do not break Guix and simulate a @code{guix pull} with:
|
||||
|
|
|
|||
|
|
@ -39,7 +39,7 @@ Copyright @copyright{} 2016, 2017, 2018, 2019 Jan Nieuwenhuizen@*
|
|||
Copyright @copyright{} 2016 Julien Lepiller@*
|
||||
Copyright @copyright{} 2016 Alex ter Weele@*
|
||||
Copyright @copyright{} 2016, 2017, 2018, 2019 Christopher Baines@*
|
||||
Copyright @copyright{} 2017, 2018 Clément Lassieur@*
|
||||
Copyright @copyright{} 2017, 2018, 2019 Clément Lassieur@*
|
||||
Copyright @copyright{} 2017, 2018 Mathieu Othacehe@*
|
||||
Copyright @copyright{} 2017 Federico Beffa@*
|
||||
Copyright @copyright{} 2017, 2018 Carlo Zancanaro@*
|
||||
|
|
@ -4598,6 +4598,18 @@ unsafe.
|
|||
The primary purpose of this operation is to facilitate inspection of
|
||||
archive contents coming from possibly untrusted substitute servers.
|
||||
|
||||
@item --list
|
||||
@itemx -t
|
||||
Read a single-item archive as served by substitute servers
|
||||
(@pxref{Substitutes}) and print the list of files it contains, as in
|
||||
this example:
|
||||
|
||||
@example
|
||||
$ wget -O - \
|
||||
https://@value{SUBSTITUTE-SERVER}/nar/lzip/@dots{}-emacs-26.3 \
|
||||
| lzip -d | guix archive -t
|
||||
@end example
|
||||
|
||||
@end table
|
||||
|
||||
|
||||
|
|
@ -7457,6 +7469,7 @@ native package build:
|
|||
(gexp->derivation "vi"
|
||||
#~(begin
|
||||
(mkdir #$output)
|
||||
(mkdir (string-append #$output "/bin"))
|
||||
(system* (string-append #+coreutils "/bin/ln")
|
||||
"-s"
|
||||
(string-append #$emacs "/bin/emacs")
|
||||
|
|
@ -10308,14 +10321,23 @@ updating list of substitutes from 'https://guix.example.org'... 100.0%
|
|||
local hash: 0725l22r5jnzazaacncwsvp9kgf42266ayyp814v7djxs7nk963q
|
||||
https://@value{SUBSTITUTE-SERVER}/nar/@dots{}-openssl-1.0.2d: 0725l22r5jnzazaacncwsvp9kgf42266ayyp814v7djxs7nk963q
|
||||
https://guix.example.org/nar/@dots{}-openssl-1.0.2d: 1zy4fmaaqcnjrzzajkdn3f5gmjk754b43qkq47llbyak9z0qjyim
|
||||
differing files:
|
||||
/lib/libcrypto.so.1.1
|
||||
/lib/libssl.so.1.1
|
||||
|
||||
/gnu/store/@dots{}-git-2.5.0 contents differ:
|
||||
local hash: 00p3bmryhjxrhpn2gxs2fy0a15lnip05l97205pgbk5ra395hyha
|
||||
https://@value{SUBSTITUTE-SERVER}/nar/@dots{}-git-2.5.0: 069nb85bv4d4a6slrwjdy8v1cn4cwspm3kdbmyb81d6zckj3nq9f
|
||||
https://guix.example.org/nar/@dots{}-git-2.5.0: 0mdqa9w1p6cmli6976v4wi0sw9r4p5prkj7lzfd1877wk11c9c73
|
||||
differing file:
|
||||
/libexec/git-core/git-fsck
|
||||
|
||||
/gnu/store/@dots{}-pius-2.1.1 contents differ:
|
||||
local hash: 0k4v3m9z1zp8xzzizb7d8kjj72f9172xv078sq4wl73vnq9ig3ax
|
||||
https://@value{SUBSTITUTE-SERVER}/nar/@dots{}-pius-2.1.1: 0k4v3m9z1zp8xzzizb7d8kjj72f9172xv078sq4wl73vnq9ig3ax
|
||||
https://guix.example.org/nar/@dots{}-pius-2.1.1: 1cy25x1a4fzq5rk0pmvc8xhwyffnqz95h2bpvqsz2mpvlbccy0gs
|
||||
differing file:
|
||||
/share/man/man1/pius.1.gz
|
||||
|
||||
@dots{}
|
||||
|
||||
|
|
@ -10344,8 +10366,20 @@ results, the inclusion of random numbers, and directory listings sorted
|
|||
by inode number. See @uref{https://reproducible-builds.org/docs/}, for
|
||||
more information.
|
||||
|
||||
To find out what is wrong with this Git binary, we can do something along
|
||||
these lines (@pxref{Invoking guix archive}):
|
||||
To find out what is wrong with this Git binary, the easiest approach is
|
||||
to run:
|
||||
|
||||
@example
|
||||
guix challenge git \
|
||||
--diff=diffoscope \
|
||||
--substitute-urls="https://@value{SUBSTITUTE-SERVER} https://guix.example.org"
|
||||
@end example
|
||||
|
||||
This automatically invokes @command{diffoscope}, which displays detailed
|
||||
information about files that differ.
|
||||
|
||||
Alternately, we can do something along these lines (@pxref{Invoking guix
|
||||
archive}):
|
||||
|
||||
@example
|
||||
$ wget -q -O - https://@value{SUBSTITUTE-SERVER}/nar/@dots{}-git-2.5.0 \
|
||||
|
|
@ -10401,6 +10435,29 @@ The one option that matters is:
|
|||
Consider @var{urls} the whitespace-separated list of substitute source
|
||||
URLs to compare to.
|
||||
|
||||
@item --diff=@var{mode}
|
||||
Upon mismatches, show differences according to @var{mode}, one of:
|
||||
|
||||
@table @asis
|
||||
@item @code{simple} (the default)
|
||||
Show the list of files that differ.
|
||||
|
||||
@item @code{diffoscope}
|
||||
@itemx @var{command}
|
||||
Invoke @uref{https://diffoscope.org/, Diffoscope}, passing it
|
||||
two directories whose contents do not match.
|
||||
|
||||
When @var{command} is an absolute file name, run @var{command} instead
|
||||
of Diffoscope.
|
||||
|
||||
@item @code{none}
|
||||
Do not show further details about the differences.
|
||||
@end table
|
||||
|
||||
Thus, unless @code{--diff=none} is passed, @command{guix challenge}
|
||||
downloads the store items from the given substitute servers so that it
|
||||
can compare them.
|
||||
|
||||
@item --verbose
|
||||
@itemx -v
|
||||
Show details about matches (identical contents) in addition to
|
||||
|
|
|
|||
20
etc/news.scm
20
etc/news.scm
|
|
@ -9,6 +9,26 @@
|
|||
(channel-news
|
||||
(version 0)
|
||||
|
||||
(entry (commit "828a39da68a9169ef1d9f9ff02a1c66b1bcbe884")
|
||||
(title (en "New @option{--diff} option for @command{guix challenge}")
|
||||
(de "Neue @option{--diff}-Option für @command{guix challenge}"))
|
||||
(body (en "The @command{guix challenge} command, which compares
|
||||
binaries provided by different substitute servers as well as those built
|
||||
locally, has a new @option{--diff} option. With @option{--diff=simple} (the
|
||||
default), @command{guix challenge} automatically downloads binaries and
|
||||
reports the list of differing files; @option{--diff=diffoscope} instructs it
|
||||
to pass them to @command{diffoscope}, which simplifies the comparison process.
|
||||
Run @command{info \"(guix) Invoking guix challenge\"}, for more info.")
|
||||
(de "Der Befehl @command{guix challenge}, mit dem Binärdateien
|
||||
von unterschiedlichen Substitut-Servern oder lokale Erstellungen miteinander
|
||||
verglichen werden können, hat eine neue Befehlszeilenoption @option{--diff}
|
||||
bekommen. Bei @option{--diff=simple} (der Voreinstellung) lädt @command{guix
|
||||
challenge} automatisch Binärdateien herunter und listet sich unterscheidende
|
||||
Dateien auf; wird @option{--diff=diffoscope} angegeben, werden sie an
|
||||
@command{diffoscope} geschickt, was deren Vergleich erleichtert. Führen Sie
|
||||
@command{info \"(guix.de) Aufruf von guix challenge\"} aus, um nähere
|
||||
Informationen zu erhalten.")))
|
||||
|
||||
(entry (commit "f675f8dec73d02e319e607559ed2316c299ae8c7")
|
||||
(title (en "New command @command{guix time-machine}")
|
||||
(de "Neuer Befehl @command{guix time-machine}")
|
||||
|
|
|
|||
|
|
@ -358,10 +358,10 @@ the last argument of `mknod'."
|
|||
(filter-map string->number (scandir "/proc")))))
|
||||
|
||||
(define* (mount-root-file-system root type
|
||||
#:key volatile-root? options)
|
||||
"Mount the root file system of type TYPE at device ROOT. If VOLATILE-ROOT?
|
||||
is true, mount ROOT read-only and make it an overlay with a writable tmpfs
|
||||
using the kernel built-in overlayfs. OPTIONS indicates the options to use
|
||||
#:key volatile-root? (flags 0) options)
|
||||
"Mount the root file system of type TYPE at device ROOT. If VOLATILE-ROOT? is
|
||||
true, mount ROOT read-only and make it an overlay with a writable tmpfs using
|
||||
the kernel built-in overlayfs. FLAGS and OPTIONS indicates the options to use
|
||||
to mount ROOT."
|
||||
|
||||
(if volatile-root?
|
||||
|
|
@ -384,7 +384,7 @@ to mount ROOT."
|
|||
"lowerdir=/real-root,upperdir=/rw-root/upper,workdir=/rw-root/work"))
|
||||
(begin
|
||||
(check-file-system root type)
|
||||
(mount root "/root" type 0 options)))
|
||||
(mount root "/root" type flags options)))
|
||||
|
||||
;; Make sure /root/etc/mtab is a symlink to /proc/self/mounts.
|
||||
(false-if-exception
|
||||
|
|
@ -474,6 +474,13 @@ upon error."
|
|||
mounts)
|
||||
"ext4"))
|
||||
|
||||
(define root-fs-flags
|
||||
(mount-flags->bit-mask (or (any (lambda (fs)
|
||||
(and (root-mount-point? fs)
|
||||
(file-system-flags fs)))
|
||||
mounts)
|
||||
'())))
|
||||
|
||||
(define root-fs-options
|
||||
(any (lambda (fs)
|
||||
(and (root-mount-point? fs)
|
||||
|
|
@ -533,6 +540,7 @@ upon error."
|
|||
(mount-root-file-system (canonicalize-device-spec root)
|
||||
root-fs-type
|
||||
#:volatile-root? volatile-root?
|
||||
#:flags root-fs-flags
|
||||
#:options root-fs-options))
|
||||
(mount "none" "/root" "tmpfs"))
|
||||
|
||||
|
|
|
|||
|
|
@ -1012,6 +1012,7 @@ dist_patch_DATA = \
|
|||
%D%/packages/patches/java-xerces-xjavac_taskdef.patch \
|
||||
%D%/packages/patches/jbig2dec-ignore-testtest.patch \
|
||||
%D%/packages/patches/kdbusaddons-kinit-file-name.patch \
|
||||
%D%/packages/patches/libnftnl-dont-check-NFTNL_FLOWTABLE_SIZE.patch \
|
||||
%D%/packages/patches/libvirt-create-machine-cgroup.patch \
|
||||
%D%/packages/patches/libziparchive-add-includes.patch \
|
||||
%D%/packages/patches/localed-xorg-keyboard.patch \
|
||||
|
|
|
|||
|
|
@ -43,14 +43,14 @@
|
|||
(define-public fio
|
||||
(package
|
||||
(name "fio")
|
||||
(version "3.14")
|
||||
(version "3.16")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://brick.kernel.dk/snaps/"
|
||||
(uri (string-append "https://brick.kernel.dk/snaps/"
|
||||
"fio-" version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"047y53nyhnmnxcrsfbsf0gcpxw7bli3n19ycscpxy9974j0fck0v"))))
|
||||
"17hi6cd4wahghh7kgvxcvmrhcqlmqag3a07id90hhzwd3zhvdxbp"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:test-target "test"
|
||||
|
|
|
|||
|
|
@ -155,7 +155,7 @@ able to synchronize with CalDAV servers through vdirsyncer.")
|
|||
(define-public remind
|
||||
(package
|
||||
(name "remind")
|
||||
(version "3.1.16")
|
||||
(version "3.1.17")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
|
|
@ -166,7 +166,7 @@ able to synchronize with CalDAV servers through vdirsyncer.")
|
|||
".")
|
||||
".tar.gz"))
|
||||
(sha256
|
||||
(base32 "14yavwqmimba8rdpwx3wlav9sfb0v5rcd1iyzqrs08wx07a9pdzf"))))
|
||||
(base32 "0lgyc2j69aqqk4knywr8inz4fsnni0zq54dgqh7p4s6kzybc2mf9"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:tests? #f)) ; no "check" target
|
||||
|
|
|
|||
|
|
@ -134,14 +134,14 @@ extraction from CDs.")
|
|||
(define-public libcdio-paranoia
|
||||
(package
|
||||
(name "libcdio-paranoia")
|
||||
(version "10.2+2.0.0")
|
||||
(version "10.2+2.0.1")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://gnu/libcdio/libcdio-paranoia-"
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"1h8k8z9r75h3p697f77z9j1blwb6gf2d5rik6z2q6420my6c2ra5"))))
|
||||
"12hfnrq7amv9qjzc92cr265m7kh0a1hpasck8cxx1gygbhqczc9k"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs `(("pkg-config" ,pkg-config)))
|
||||
(propagated-inputs `(("libcdio" ,libcdio)))
|
||||
|
|
|
|||
|
|
@ -58,6 +58,7 @@
|
|||
(variable "COQPATH")
|
||||
(files (list "lib/coq/user-contrib")))))
|
||||
(build-system ocaml-build-system)
|
||||
(outputs '("out" "ide"))
|
||||
(inputs
|
||||
`(("lablgtk" ,lablgtk)
|
||||
("python" ,python-2)
|
||||
|
|
@ -72,6 +73,13 @@
|
|||
(lambda _
|
||||
(for-each make-file-writable (find-files "."))
|
||||
#t))
|
||||
(add-after 'unpack 'remove-lablgtk-references
|
||||
(lambda _
|
||||
;; This is not used anywhere, but creates a reference to lablgtk in
|
||||
;; every binary
|
||||
(substitute* '("config/coq_config.mli" "configure.ml")
|
||||
((".*coqideincl.*") ""))
|
||||
#t))
|
||||
(replace 'configure
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
|
|
@ -88,6 +96,23 @@
|
|||
"-j" (number->string (parallel-job-count))
|
||||
"world")))
|
||||
(delete 'check)
|
||||
(add-after 'install 'remove-duplicate
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let* ((out (assoc-ref outputs "out"))
|
||||
(bin (string-append out "/bin")))
|
||||
;; These are exact copies of the version without the .opt suffix.
|
||||
;; Remove them to save 35 MiB in the result
|
||||
(delete-file (string-append bin "/coqtop.opt"))
|
||||
(delete-file (string-append bin "/coqidetop.opt")))
|
||||
#t))
|
||||
(add-after 'install 'install-ide
|
||||
(lambda* (#:key outputs #:allow-other-keys)
|
||||
(let ((out (assoc-ref outputs "out"))
|
||||
(ide (assoc-ref outputs "ide")))
|
||||
(mkdir-p (string-append ide "/bin"))
|
||||
(rename-file (string-append out "/bin/coqide")
|
||||
(string-append ide "/bin/coqide")))
|
||||
#t))
|
||||
(add-after 'install 'check
|
||||
(lambda _
|
||||
(with-directory-excursion "test-suite"
|
||||
|
|
|
|||
|
|
@ -19816,6 +19816,33 @@ Emacs that integrate with major modes like Org-mode.")
|
|||
(home-page "https://github.com/hlissner/emacs-doom-themes")
|
||||
(license license:expat)))
|
||||
|
||||
(define-public emacs-modus-themes
|
||||
(package
|
||||
(name "emacs-modus-themes")
|
||||
(version "0.1.0")
|
||||
(source
|
||||
(origin
|
||||
(method git-fetch)
|
||||
(uri (git-reference
|
||||
(url "https://gitlab.com/protesilaos/modus-themes.git")
|
||||
(commit version)))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"15g63675c5df2p0kk2sqj2c8qriyh69lcbggknqlaxapr13giz4x"))))
|
||||
(build-system emacs-build-system)
|
||||
(home-page "https://gitlab.com/protesilaos/modus-themes")
|
||||
(synopsis "Emacs themes designed for colour-contrast accessibility")
|
||||
(description
|
||||
"This is a set of accessible themes for GNU Emacs. The contrast ratio
|
||||
between foreground and background values should always be >= 7:1, which
|
||||
conforms with the WCAG AAA accessibility standard.
|
||||
|
||||
The Modus themes project consists of two standalone items, one where dark text
|
||||
is cast on a light backdrop (Modus Operandi) and another where light text is
|
||||
displayed against a dark background (Modus Vivendi).")
|
||||
(license license:gpl3+)))
|
||||
|
||||
(define-public emacs-elixir-mode
|
||||
(package
|
||||
(name "emacs-elixir-mode")
|
||||
|
|
@ -20046,9 +20073,9 @@ fish-completion. It can be used in both Eshell and M-x shell.")
|
|||
(license license:gpl3+))))
|
||||
|
||||
(define-public emacs-telega
|
||||
(let ((commit "56aef884921d99e5170d5425dbe0fce645620511")
|
||||
(let ((commit "6184e76990db395bea02f7b5d3169e746111e1ad")
|
||||
(revision "2")
|
||||
(version "0.4.4"))
|
||||
(version "0.5.2"))
|
||||
(package
|
||||
(name "emacs-telega")
|
||||
(version (git-version version revision commit))
|
||||
|
|
@ -20060,7 +20087,7 @@ fish-completion. It can be used in both Eshell and M-x shell.")
|
|||
(commit commit)))
|
||||
(sha256
|
||||
(base32
|
||||
"0a8k3j20nz4xwswg9qp9xpaakk3q3ibiz8mkryk92zmrdmaah5mi"))
|
||||
"1kfmmfc9dv3r2wxm1njflgas51qm0j8sj7yr7vfvwaz5sz7p121b"))
|
||||
(file-name (git-file-name name version))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
|
|
@ -20142,15 +20169,17 @@ fish-completion. It can be used in both Eshell and M-x shell.")
|
|||
(add-after 'emacs-build 'emacs-make-autoloads
|
||||
(assoc-ref emacs:%standard-phases 'make-autoloads)))))
|
||||
(propagated-inputs
|
||||
`(("emacs-visual-fill-column" ,emacs-visual-fill-column)))
|
||||
`(("emacs-visual-fill-column" ,emacs-visual-fill-column)
|
||||
("ffmpeg" ,ffmpeg) ; mp4/gif support.
|
||||
("libwebp" ,libwebp))) ; sticker support.
|
||||
(native-inputs
|
||||
`(("tdlib" ,tdlib)
|
||||
("emacs" ,emacs-minimal)
|
||||
("python" ,python)))
|
||||
(synopsis "GNU Emacs client for the Telegram messenger")
|
||||
(description
|
||||
"Telega is full-featured, unofficial client for the Telegram messaging
|
||||
platform for GNU Emacs.")
|
||||
"Telega is a full-featured, unofficial GNU Emacs-based client for the
|
||||
Telegram messaging platform.")
|
||||
(home-page "https://github.com/zevlg/telega.el")
|
||||
(license license:gpl3+))))
|
||||
|
||||
|
|
|
|||
|
|
@ -170,7 +170,7 @@ script.")
|
|||
(define-public graphicsmagick
|
||||
(package
|
||||
(name "graphicsmagick")
|
||||
(version "1.3.32")
|
||||
(version "1.3.33")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
|
|
@ -182,8 +182,7 @@ script.")
|
|||
"GraphicsMagick/" (version-major+minor version)
|
||||
"/GraphicsMagick-" version ".tar.xz")))
|
||||
(sha256
|
||||
(base32
|
||||
"1qclp9i31idpcbbqswmnq2q11lmv0a7cvdb1y72xcky8sshaahmq"))))
|
||||
(base32 "0y67dl6xbk1pxndppa93hhlq9i6bpcjw39gb4i8hnn1klqqb630k"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:configure-flags
|
||||
|
|
|
|||
|
|
@ -104,7 +104,7 @@ that are shared between @command{go-ipfs/commands} and its rewrite
|
|||
(define-public gx
|
||||
(package
|
||||
(name "gx")
|
||||
(version "0.14.1")
|
||||
(version "0.14.2")
|
||||
(source
|
||||
(origin
|
||||
(method git-fetch)
|
||||
|
|
@ -113,8 +113,7 @@ that are shared between @command{go-ipfs/commands} and its rewrite
|
|||
(commit (string-append "v" version))))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"0pfx2p59xdbmqzfbgaf8xvlnzh8m05hkg596glq5kvl8ib65i4ha"))))
|
||||
(base32 "048bx6khzcwxnvz3lf7kgp6fkg8mxqcqchxh0jxm9fg2iwizsi0k"))))
|
||||
(build-system go-build-system)
|
||||
(arguments
|
||||
'(#:import-path "github.com/whyrusleeping/gx"))
|
||||
|
|
|
|||
|
|
@ -174,14 +174,14 @@ spreadsheets and presentations.")
|
|||
(define-public libwpd
|
||||
(package
|
||||
(name "libwpd")
|
||||
(version "0.10.2")
|
||||
(version "0.10.3")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://sourceforge/libwpd/libwpd/"
|
||||
"libwpd-" version "/libwpd-" version ".tar.xz"))
|
||||
(sha256 (base32
|
||||
"0436gnidx45a9vx114hhh216jrh57mqb9zyssyjfadagmyz6hgrj"))))
|
||||
"02fx8bngslcj7i5g1gx2kiign4vp09wrmp5wpvix9igxcavb0r94"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
`(#:configure-flags '("--disable-werror")))
|
||||
|
|
|
|||
|
|
@ -1678,7 +1678,7 @@ external rate conversion.")
|
|||
(define-public iptables
|
||||
(package
|
||||
(name "iptables")
|
||||
(version "1.6.2")
|
||||
(version "1.8.4")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append
|
||||
|
|
@ -1686,7 +1686,7 @@ external rate conversion.")
|
|||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"0crp0lvh5m2f15pr8cw97h8yb8zjj10x95zj06j46cr68vx2vl2m"))))
|
||||
"0z0mgs1ghvn3slc868mgbf2g26njgrzcy5ggyb5w4i55j1a3lflr"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
`(("pkg-config" ,pkg-config)
|
||||
|
|
@ -5233,14 +5233,16 @@ re-use code and to avoid re-inventing the wheel.")
|
|||
(define-public libnftnl
|
||||
(package
|
||||
(name "libnftnl")
|
||||
(version "1.1.4")
|
||||
(version "1.1.5")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://netfilter.org/libnftnl/"
|
||||
"libnftnl-" version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32 "087dfc2n4saf2k68hyi4byvgz5grwpw5kfjvmkpn3wmd8y1riiy8"))))
|
||||
(base32 "1wqlxf76bkqf3qhka9sw32qhb2ni20q1k6rn3iril2kw482lvpk6"))
|
||||
(patches
|
||||
(search-patches "libnftnl-dont-check-NFTNL_FLOWTABLE_SIZE.patch"))))
|
||||
(build-system gnu-build-system)
|
||||
(native-inputs
|
||||
`(("pkg-config" ,pkg-config)))
|
||||
|
|
@ -5257,15 +5259,16 @@ used by nftables.")
|
|||
(define-public nftables
|
||||
(package
|
||||
(name "nftables")
|
||||
(version "0.9.2")
|
||||
(version "0.9.3")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "http://www.nftables.org/projects/nftables"
|
||||
"/files/nftables-" version ".tar.bz2"))
|
||||
(uri (list (string-append "mirror://netfilter.org/nftables/nftables-"
|
||||
version ".tar.bz2")
|
||||
(string-append "https://www.nftables.org/projects/nftables"
|
||||
"/files/nftables-" version ".tar.bz2")))
|
||||
(sha256
|
||||
(base32
|
||||
"1x8kalbggjq44j4916i6vyv1rb20dlh1dcsf9xvzqsry2j063djw"))))
|
||||
(base32 "0y6vbqp6x8w165q65h4n9sba1406gaz0d4744gqszbm7w9f92swm"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments `(#:configure-flags
|
||||
'("--disable-man-doc"))) ; FIXME: Needs docbook2x.
|
||||
|
|
@ -5276,7 +5279,7 @@ used by nftables.")
|
|||
("libnftnl" ,libnftnl)
|
||||
("readline" ,readline)))
|
||||
(native-inputs `(("pkg-config" ,pkg-config)))
|
||||
(home-page "http://www.nftables.org")
|
||||
(home-page "https://www.nftables.org")
|
||||
(synopsis "Userspace utility for Linux packet filtering")
|
||||
(description "nftables is the project that aims to replace the existing
|
||||
{ip,ip6,arp,eb}tables framework. Basically, this project provides a new packet
|
||||
|
|
|
|||
|
|
@ -555,15 +555,14 @@ Extension (MIME).")
|
|||
(define-public bogofilter
|
||||
(package
|
||||
(name "bogofilter")
|
||||
(version "1.2.4")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://sourceforge/bogofilter/bogofilter-"
|
||||
version "/bogofilter-"
|
||||
version ".tar.bz2"))
|
||||
(sha256
|
||||
(base32
|
||||
"1d56n2m9inm8gnzm88aa27xl2a7sp7aff3484vmflpqkinjqf0p1"))))
|
||||
(version "1.2.5")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "mirror://sourceforge/bogofilter/bogofilter-stable/"
|
||||
"bogofilter-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32 "1sl9xrnnlk2sn8gmibhn8li09vnansjbxb9l1182qmgz7cvs2j1j"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:phases
|
||||
|
|
@ -576,14 +575,14 @@ Extension (MIME).")
|
|||
#t)))))
|
||||
(native-inputs `(("flex" ,flex)))
|
||||
(inputs `(("bdb" ,bdb)))
|
||||
(home-page "http://bogofilter.sourceforge.net/")
|
||||
(home-page "https://bogofilter.sourceforge.io/")
|
||||
(synopsis "Mail classifier based on a Bayesian filter")
|
||||
(description
|
||||
"Bogofilter is a mail filter that classifies mail as spam or ham
|
||||
(non-spam) by a statistical analysis of the message's header and
|
||||
content (body). The program is able to learn from the user's classifications
|
||||
and corrections. It is based on a Bayesian filter.")
|
||||
(license gpl2)))
|
||||
(license gpl3+)))
|
||||
|
||||
(define-public offlineimap
|
||||
(package
|
||||
|
|
|
|||
|
|
@ -3924,7 +3924,7 @@ sample library.")
|
|||
(string-map (lambda (c)
|
||||
(if (char=? c #\.)
|
||||
#\_ c)) version)))))
|
||||
(file-name (string-append name "-" version "-checkout"))
|
||||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"1nninz8qyqlxxjdnrm79y3gr3056pga9l2fsqh674jd3cjvafya3"))))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,47 @@
|
|||
From: Tobias Geerinckx-Rice <me@tobias.gr>
|
||||
Date: Tue, 10 Dec 2019 16:20:40 +0100
|
||||
Subject: gnu: libnftnl: Don't check NFTNL_FLOWTABLE_SIZE.
|
||||
|
||||
Taken verbatim from the upstream commit[0] directly following the 1.1.5
|
||||
release.
|
||||
|
||||
[0]: https://git.netfilter.org/libnftnl/commit/?id=b2388765e0c4405442faa13845419f6a35d0134c
|
||||
|
||||
From b2388765e0c4405442faa13845419f6a35d0134c Mon Sep 17 00:00:00 2001
|
||||
From: Phil Sutter <phil@nwl.cc>
|
||||
Date: Mon, 2 Dec 2019 18:29:56 +0100
|
||||
Subject: tests: flowtable: Don't check NFTNL_FLOWTABLE_SIZE
|
||||
|
||||
Marshalling code around that attribute has been dropped by commit
|
||||
d1c4b98c733a5 ("flowtable: remove NFTA_FLOWTABLE_SIZE") so it's value is
|
||||
lost during the test.
|
||||
|
||||
Assuming that NFTNL_FLOWTABLE_SIZE will receive kernel support at a
|
||||
later point, leave the test code in place but just comment it out.
|
||||
|
||||
Fixes: d1c4b98c733a5 ("flowtable: remove NFTA_FLOWTABLE_SIZE")
|
||||
Signed-off-by: Phil Sutter <phil@nwl.cc>
|
||||
Acked-by: Pablo Neira Ayuso <pablo@netfilter.org>
|
||||
---
|
||||
tests/nft-flowtable-test.c | 2 ++
|
||||
1 file changed, 2 insertions(+)
|
||||
|
||||
diff --git a/tests/nft-flowtable-test.c b/tests/nft-flowtable-test.c
|
||||
index 3edb00d..8ab8d4c 100644
|
||||
--- a/tests/nft-flowtable-test.c
|
||||
+++ b/tests/nft-flowtable-test.c
|
||||
@@ -33,9 +33,11 @@ static void cmp_nftnl_flowtable(struct nftnl_flowtable *a, struct nftnl_flowtabl
|
||||
if (nftnl_flowtable_get_u32(a, NFTNL_FLOWTABLE_USE) !=
|
||||
nftnl_flowtable_get_u32(b, NFTNL_FLOWTABLE_USE))
|
||||
print_err("Flowtable use mismatches");
|
||||
+#if 0
|
||||
if (nftnl_flowtable_get_u32(a, NFTNL_FLOWTABLE_SIZE) !=
|
||||
nftnl_flowtable_get_u32(b, NFTNL_FLOWTABLE_SIZE))
|
||||
print_err("Flowtable size mismatches");
|
||||
+#endif
|
||||
if (nftnl_flowtable_get_u32(a, NFTNL_FLOWTABLE_FLAGS) !=
|
||||
nftnl_flowtable_get_u32(b, NFTNL_FLOWTABLE_FLAGS))
|
||||
print_err("Flowtable flags mismatches");
|
||||
--
|
||||
cgit v1.2.1
|
||||
|
||||
|
|
@ -14327,24 +14327,15 @@ such as figshare or Zenodo.")
|
|||
(define-public python-semver
|
||||
(package
|
||||
(name "python-semver")
|
||||
(version "2.7.9")
|
||||
(version "2.9.0")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "semver" version))
|
||||
(sha256
|
||||
(base32
|
||||
"0hhgqppchv59rqj0yzi1prdg2nfsywqmjsqy2rycyxm0hvxmbyqz"))))
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "semver" version))
|
||||
(sha256
|
||||
(base32
|
||||
"183kg1rhzz3hqizvphkd8hlbf1zxfx8737zhfkmqzxi71jmdw7pd"))))
|
||||
(build-system python-build-system)
|
||||
(arguments
|
||||
`(#:phases
|
||||
(modify-phases %standard-phases
|
||||
(add-after 'unpack 'patch-test-requirements
|
||||
(lambda _
|
||||
(substitute* "setup.py"
|
||||
;; Our Python is new enough.
|
||||
(("'virtualenv<14\\.0\\.0'") "'virtualenv'"))
|
||||
#t)))))
|
||||
(native-inputs
|
||||
`(("python-tox" ,python-tox)
|
||||
("python-virtualenv" ,python-virtualenv)))
|
||||
|
|
@ -14564,14 +14555,14 @@ user's @file{~/Trash} directory.")
|
|||
(define-public python-yapf
|
||||
(package
|
||||
(name "python-yapf")
|
||||
(version "0.24.0")
|
||||
(version "0.29.0")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "yapf" version))
|
||||
(sha256
|
||||
(base32
|
||||
"0anwby0ydmyzcsgjc5dn1ryddwvii4dq61vck447q0n96npnzfyf"))))
|
||||
"1pj3xzblmbssshi889b6n9hwqbjpabw6j0fimlng2sshd3226bki"))))
|
||||
(build-system python-build-system)
|
||||
(home-page "https://github.com/google/yapf")
|
||||
(synopsis "Formatter for Python code")
|
||||
|
|
|
|||
|
|
@ -16,6 +16,7 @@
|
|||
;;; Copyright © 2018, 2019 Eric Bavier <bavier@member.fsf.org>
|
||||
;;; Copyright © 2019 Julien Lepiller <julien@lepiller.eu>
|
||||
;;; Copyright © 2019 Pierre Langlois <pierre.langlois@gmx.com>
|
||||
;;; Copyright © 2019 Brett Gilio <brettg@posteo.net>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -828,20 +829,21 @@ of VT100 terminal.")
|
|||
(define-public python-blessings
|
||||
(package
|
||||
(name "python-blessings")
|
||||
(version "1.6.1")
|
||||
(version "1.7")
|
||||
(source
|
||||
(origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "blessings" version))
|
||||
(sha256
|
||||
(base32
|
||||
"1smngy65p8mi62lgm04icasx22v976szhs2aq95y2ljmi1srb4bl"))))
|
||||
"0z8mgkbmisxs10rz88qg46l1c9a8n08k8cy2iassal2zh16qbrcq"))))
|
||||
(build-system python-build-system)
|
||||
(arguments
|
||||
;; TODO: For py3, 2to2 is used to convert the code, but test-suite fails
|
||||
;; FIXME: Test suite is unable to detect TTY conditions.
|
||||
`(#:tests? #f))
|
||||
(native-inputs
|
||||
`(("python-nose" ,python-nose)))
|
||||
`(("python-nose" ,python-nose)
|
||||
("python-six" ,python-six)))
|
||||
(home-page "https://github.com/erikrose/blessings")
|
||||
(synopsis "Python module to manage terminal color, styling, and
|
||||
positioning")
|
||||
|
|
|
|||
|
|
@ -553,13 +553,13 @@ netcat implementation that supports TLS.")
|
|||
(package
|
||||
(name "python-acme")
|
||||
;; Remember to update the hash of certbot when updating python-acme.
|
||||
(version "0.40.1")
|
||||
(version "1.0.0")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (pypi-uri "acme" version))
|
||||
(sha256
|
||||
(base32
|
||||
"1z2zibs9lyxi5gxw9bny1127bjliwsp476kai1wnnnwd8238dgrk"))))
|
||||
"1hl62dnh8zsipa5azzpy5kwgjgb5vflinhna1fsn7rcchhpz223a"))))
|
||||
(build-system python-build-system)
|
||||
(arguments
|
||||
`(#:phases
|
||||
|
|
@ -610,7 +610,7 @@ netcat implementation that supports TLS.")
|
|||
(uri (pypi-uri "certbot" version))
|
||||
(sha256
|
||||
(base32
|
||||
"1l8h7ggq75h59246mmzigmjr5jvzi29hihrnz9aiqh6g8hq1pj4d"))))
|
||||
"0aih7sir5byy8ah9lrgzwcaga7hjw98qj8bb1pxzzzqrvcqjvf46"))))
|
||||
(build-system python-build-system)
|
||||
(arguments
|
||||
`(,@(substitute-keyword-arguments (package-arguments python-acme)
|
||||
|
|
|
|||
|
|
@ -456,14 +456,14 @@ The peer-to-peer VPN implements a Layer 2 (Ethernet) network between the peers
|
|||
(define-public wireguard
|
||||
(package
|
||||
(name "wireguard")
|
||||
(version "0.0.20191127")
|
||||
(version "0.0.20191212")
|
||||
(source (origin
|
||||
(method url-fetch)
|
||||
(uri (string-append "https://git.zx2c4.com/WireGuard/snapshot/"
|
||||
"WireGuard-" version ".tar.xz"))
|
||||
(sha256
|
||||
(base32
|
||||
"01ixdhbvx5yiq07msd60f98685wdksss4pfhdn1d8r25z2k80kkx"))))
|
||||
"0wdhl7i4zkb7yf0jj03ig2ks7bsfz9if8x9dy6r2523s1ww1imxh"))))
|
||||
(build-system gnu-build-system)
|
||||
(outputs '("out" ; The WireGuard userspace tools
|
||||
"kernel-patch")) ; A patch to build Linux with WireGuard support
|
||||
|
|
|
|||
|
|
@ -4194,8 +4194,8 @@ CDF, Atom 0.3, and Atom 1.0 feeds.")
|
|||
(package-with-python2 python-feedparser))
|
||||
|
||||
(define-public guix-data-service
|
||||
(let ((commit "af1324855e1ecaf9b1dd7afcc714d09aaa38f081")
|
||||
(revision "6"))
|
||||
(let ((commit "156b7eea7e7d538e332d8cfcf482c5ebec0a25c0")
|
||||
(revision "7"))
|
||||
(package
|
||||
(name "guix-data-service")
|
||||
(version (string-append "0.0.1-" revision "." (string-take commit 7)))
|
||||
|
|
@ -4207,7 +4207,7 @@ CDF, Atom 0.3, and Atom 1.0 feeds.")
|
|||
(file-name (git-file-name name version))
|
||||
(sha256
|
||||
(base32
|
||||
"1qxs1sbyx894njw4f898wzc5shjj85h9kgz95p8mq1acmazhlhkv"))))
|
||||
"1cg7jzk7pabfp3mgnkpycasv7fs522xp3nqdvna1y76aif3pd3zh"))))
|
||||
(build-system gnu-build-system)
|
||||
(arguments
|
||||
'(#:modules ((guix build utils)
|
||||
|
|
@ -4251,6 +4251,7 @@ CDF, Atom 0.3, and Atom 1.0 feeds.")
|
|||
"guix-data-service-process-branch-updated-mbox"
|
||||
"guix-data-service-process-job"
|
||||
"guix-data-service-process-jobs"
|
||||
"guix-data-service-manage-build-servers"
|
||||
"guix-data-service-query-build-servers"))
|
||||
#t)))
|
||||
(delete 'strip)))) ; As the .go files aren't compatible
|
||||
|
|
|
|||
|
|
@ -76,8 +76,18 @@ archive, a directory, or an Emacs Lisp file."
|
|||
(define* (add-source-to-load-path #:key dummy #:allow-other-keys)
|
||||
"Augment the EMACSLOADPATH environment variable with the source directory."
|
||||
(let* ((source-directory (getcwd))
|
||||
(emacs-load-path-value (string-append source-directory ":"
|
||||
(getenv "EMACSLOADPATH"))))
|
||||
(emacs-load-path (string-split (getenv "EMACSLOADPATH") #\:))
|
||||
;; XXX: Make sure the Emacs core libraries appear at the end of
|
||||
;; EMACSLOADPATH, to avoid shadowing any other libraries depended
|
||||
;; upon.
|
||||
(emacs-load-path-non-core (filter (cut string-contains <>
|
||||
"/share/emacs/site-lisp")
|
||||
emacs-load-path))
|
||||
(emacs-load-path-value (string-append
|
||||
(string-join (cons source-directory
|
||||
emacs-load-path-non-core)
|
||||
":")
|
||||
":")))
|
||||
(setenv "EMACSLOADPATH" emacs-load-path-value)
|
||||
(format #t "source directory ~s prepended to the `EMACSLOADPATH' \
|
||||
environment variable\n" source-directory)))
|
||||
|
|
|
|||
|
|
@ -40,6 +40,7 @@
|
|||
progress-reporter/file
|
||||
progress-reporter/bar
|
||||
progress-reporter/trace
|
||||
progress-report-port
|
||||
|
||||
display-download-progress
|
||||
erase-current-line
|
||||
|
|
@ -342,3 +343,33 @@ should be a <progress-reporter> object."
|
|||
(put-bytevector out buffer 0 bytes)
|
||||
(report total)
|
||||
(loop total (get-bytevector-n! in buffer 0 buffer-size))))))))
|
||||
|
||||
(define (progress-report-port reporter port)
|
||||
"Return a port that continuously reports the bytes read from PORT using
|
||||
REPORTER, which should be a <progress-reporter> object."
|
||||
(match reporter
|
||||
(($ <progress-reporter> start report stop)
|
||||
(let* ((total 0)
|
||||
(read! (lambda (bv start count)
|
||||
(let ((n (match (get-bytevector-n! port bv start count)
|
||||
((? eof-object?) 0)
|
||||
(x x))))
|
||||
(set! total (+ total n))
|
||||
(report total)
|
||||
n))))
|
||||
(start)
|
||||
(make-custom-binary-input-port "progress-port-proc"
|
||||
read! #f #f
|
||||
(lambda ()
|
||||
;; XXX: Kludge! When used through
|
||||
;; 'decompressed-port', this port ends
|
||||
;; up being closed twice: once in a
|
||||
;; child process early on, and at the
|
||||
;; end in the parent process. Ignore
|
||||
;; the early close so we don't output
|
||||
;; a spurious "download-succeeded"
|
||||
;; trace.
|
||||
(unless (zero? total)
|
||||
(stop))
|
||||
(close-port port)))))))
|
||||
|
||||
|
|
|
|||
|
|
@ -21,7 +21,8 @@
|
|||
#:use-module (guix utils)
|
||||
#:use-module (guix combinators)
|
||||
#:use-module ((guix build utils) #:select (mkdir-p))
|
||||
#:use-module ((guix serialization) #:select (restore-file))
|
||||
#:use-module ((guix serialization)
|
||||
#:select (fold-archive restore-file))
|
||||
#:use-module (guix store)
|
||||
#:use-module ((guix status) #:select (with-status-verbosity))
|
||||
#:use-module (guix grafts)
|
||||
|
|
@ -43,6 +44,7 @@
|
|||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-37)
|
||||
#:use-module (ice-9 binary-ports)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:export (guix-archive
|
||||
options->derivations+files))
|
||||
|
||||
|
|
@ -76,6 +78,8 @@ Export/import one or more packages from/to the store.\n"))
|
|||
--missing print the files from stdin that are missing"))
|
||||
(display (G_ "
|
||||
-x, --extract=DIR extract the archive on stdin to DIR"))
|
||||
(display (G_ "
|
||||
-t, --list list the files in the archive on stdin"))
|
||||
(newline)
|
||||
(display (G_ "
|
||||
--generate-key[=PARAMETERS]
|
||||
|
|
@ -137,6 +141,9 @@ Export/import one or more packages from/to the store.\n"))
|
|||
(option '("extract" #\x) #t #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'extract arg result)))
|
||||
(option '("list" #\t) #f #f
|
||||
(lambda (opt name arg result)
|
||||
(alist-cons 'list #t result)))
|
||||
(option '("generate-key") #f #t
|
||||
(lambda (opt name arg result)
|
||||
(catch 'gcry-error
|
||||
|
|
@ -319,6 +326,40 @@ the input port."
|
|||
(with-atomic-file-output %acl-file
|
||||
(cut write-acl acl <>)))))
|
||||
|
||||
(define (list-contents port)
|
||||
"Read a nar from PORT and print the list of files it contains to the current
|
||||
output port."
|
||||
(define (consume-input port size)
|
||||
(let ((bv (make-bytevector 32768)))
|
||||
(let loop ((total size))
|
||||
(unless (zero? total)
|
||||
(let ((n (get-bytevector-n! port bv 0
|
||||
(min total (bytevector-length bv)))))
|
||||
(loop (- total n)))))))
|
||||
|
||||
(fold-archive (lambda (file type content result)
|
||||
(match type
|
||||
('directory
|
||||
(format #t "D ~a~%" file))
|
||||
('symlink
|
||||
(format #t "S ~a -> ~a~%" file content))
|
||||
((or 'regular 'executable)
|
||||
(match content
|
||||
((input . size)
|
||||
(format #t "~a ~60a ~10h B~%"
|
||||
(if (eq? type 'executable)
|
||||
"x" "r")
|
||||
file size)
|
||||
(consume-input input size))))))
|
||||
#t
|
||||
port
|
||||
""))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Entry point.
|
||||
;;;
|
||||
|
||||
(define (guix-archive . args)
|
||||
(define (lines port)
|
||||
;; Return lines read from PORT.
|
||||
|
|
@ -353,6 +394,8 @@ the input port."
|
|||
(missing (remove (cut valid-path? store <>)
|
||||
files)))
|
||||
(format #t "~{~a~%~}" missing)))
|
||||
((assoc-ref opts 'list)
|
||||
(list-contents (current-input-port)))
|
||||
((assoc-ref opts 'extract)
|
||||
=>
|
||||
(lambda (target)
|
||||
|
|
|
|||
|
|
@ -25,17 +25,23 @@
|
|||
#:use-module (guix monads)
|
||||
#:use-module (guix base32)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix progress)
|
||||
#:use-module (guix serialization)
|
||||
#:use-module (guix scripts substitute)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:autoload (guix http-client) (http-fetch)
|
||||
#:use-module ((guix build syscalls) #:select (terminal-columns))
|
||||
#:use-module (gcrypt hash)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-9)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-34)
|
||||
#:use-module (srfi srfi-37)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 vlist)
|
||||
#:use-module (ice-9 format)
|
||||
#:use-module (ice-9 ftw)
|
||||
#:use-module (web uri)
|
||||
#:export (compare-contents
|
||||
|
||||
|
|
@ -49,6 +55,9 @@
|
|||
comparison-report-mismatch?
|
||||
comparison-report-inconclusive?
|
||||
|
||||
differing-files
|
||||
call-with-mismatches
|
||||
|
||||
guix-challenge))
|
||||
|
||||
;;; Commentary:
|
||||
|
|
@ -179,20 +188,192 @@ taken since we do not import the archives."
|
|||
items
|
||||
local))))
|
||||
|
||||
|
||||
;;;
|
||||
;;; Reporting.
|
||||
;;;
|
||||
|
||||
(define dump-port* ;FIXME: deduplicate
|
||||
(@@ (guix serialization) dump))
|
||||
|
||||
(define (port-sha256* port size)
|
||||
;; Like 'port-sha256', but limited to SIZE bytes.
|
||||
(let-values (((out get) (open-sha256-port)))
|
||||
(dump-port* port out size)
|
||||
(close-port out)
|
||||
(get)))
|
||||
|
||||
(define (archive-contents port)
|
||||
"Return a list representing the files contained in the nar read from PORT."
|
||||
(fold-archive (lambda (file type contents result)
|
||||
(match type
|
||||
((or 'regular 'executable)
|
||||
(match contents
|
||||
((port . size)
|
||||
(cons `(,file ,type ,(port-sha256* port size))
|
||||
result))))
|
||||
('directory result)
|
||||
('symlink
|
||||
(cons `(,file ,type ,contents) result))))
|
||||
'()
|
||||
port
|
||||
""))
|
||||
|
||||
(define (store-item-contents item)
|
||||
"Return a list of files and contents for ITEM in the same format as
|
||||
'archive-contents'."
|
||||
(file-system-fold (const #t) ;enter?
|
||||
(lambda (file stat result) ;leaf
|
||||
(define short
|
||||
(string-drop file (string-length item)))
|
||||
|
||||
(match (stat:type stat)
|
||||
('regular
|
||||
(let ((size (stat:size stat))
|
||||
(type (if (zero? (logand (stat:mode stat)
|
||||
#o100))
|
||||
'regular
|
||||
'executable)))
|
||||
(cons `(,short ,type
|
||||
,(call-with-input-file file
|
||||
(cut port-sha256* <> size)))
|
||||
result)))
|
||||
('symlink
|
||||
(cons `(,short symlink ,(readlink file))
|
||||
result))))
|
||||
(lambda (directory stat result) result) ;down
|
||||
(lambda (directory stat result) result) ;up
|
||||
(lambda (file stat result) result) ;skip
|
||||
(lambda (file stat errno result) result) ;error
|
||||
'()
|
||||
item
|
||||
lstat))
|
||||
|
||||
(define (call-with-nar narinfo proc)
|
||||
"Call PROC with an input port from which it can read the nar pointed to by
|
||||
NARINFO."
|
||||
(let*-values (((uri compression size)
|
||||
(narinfo-best-uri narinfo))
|
||||
((port response)
|
||||
(http-fetch uri)))
|
||||
(define reporter
|
||||
(progress-reporter/file (narinfo-path narinfo) size
|
||||
#:abbreviation (const (uri-host uri))))
|
||||
|
||||
(define result
|
||||
(call-with-decompressed-port (string->symbol compression)
|
||||
(progress-report-port reporter port)
|
||||
proc))
|
||||
|
||||
(close-port port)
|
||||
(erase-current-line (current-output-port))
|
||||
result))
|
||||
|
||||
(define (narinfo-contents narinfo)
|
||||
"Fetch the nar described by NARINFO and return a list representing the file
|
||||
it contains."
|
||||
(call-with-nar narinfo archive-contents))
|
||||
|
||||
(define (differing-files comparison-report)
|
||||
"Return a list of files that differ among the nars and possibly the local
|
||||
store item specified in COMPARISON-REPORT."
|
||||
(define contents
|
||||
(map narinfo-contents
|
||||
(comparison-report-narinfos comparison-report)))
|
||||
|
||||
(define local-contents
|
||||
(and (comparison-report-local-sha256 comparison-report)
|
||||
(store-item-contents (comparison-report-item comparison-report))))
|
||||
|
||||
(match (apply lset-difference equal?
|
||||
(take (delete-duplicates
|
||||
(if local-contents
|
||||
(cons local-contents contents)
|
||||
contents))
|
||||
2))
|
||||
(((files _ ...) ...)
|
||||
files)))
|
||||
|
||||
(define (report-differing-files comparison-report)
|
||||
"Report differences among the nars and possibly the local store item
|
||||
specified in COMPARISON-REPORT."
|
||||
(match (differing-files comparison-report)
|
||||
(()
|
||||
#t)
|
||||
((files ...)
|
||||
(format #t (N_ " differing file:~%"
|
||||
" differing files:~%"
|
||||
(length files)))
|
||||
(format #t "~{ ~a~%~}" files))))
|
||||
|
||||
(define (call-with-mismatches comparison-report proc)
|
||||
"Call PROC with two directories containing the mismatching store items."
|
||||
(define local-hash
|
||||
(comparison-report-local-sha256 comparison-report))
|
||||
|
||||
(define narinfos
|
||||
(comparison-report-narinfos comparison-report))
|
||||
|
||||
(call-with-temporary-directory
|
||||
(lambda (directory1)
|
||||
(call-with-temporary-directory
|
||||
(lambda (directory2)
|
||||
(define narinfo1
|
||||
(if local-hash
|
||||
(find (lambda (narinfo)
|
||||
(not (string=? (narinfo-hash narinfo)
|
||||
local-hash)))
|
||||
narinfos)
|
||||
(first (comparison-report-narinfos comparison-report))))
|
||||
|
||||
(define narinfo2
|
||||
(and (not local-hash)
|
||||
(find (lambda (narinfo)
|
||||
(not (eq? narinfo narinfo1)))
|
||||
narinfos)))
|
||||
|
||||
(rmdir directory1)
|
||||
(call-with-nar narinfo1 (cut restore-file <> directory1))
|
||||
(when narinfo2
|
||||
(rmdir directory2)
|
||||
(call-with-nar narinfo2 (cut restore-file <> directory2)))
|
||||
(proc directory1
|
||||
(if local-hash
|
||||
(comparison-report-item comparison-report)
|
||||
directory2)))))))
|
||||
|
||||
(define %diffoscope-command
|
||||
;; Default external diff command. Pass "--exclude-directory-metadata" so
|
||||
;; that the mtime/ctime differences are ignored.
|
||||
'("diffoscope" "--exclude-directory-metadata=yes"))
|
||||
|
||||
(define* (report-differing-files/external comparison-report
|
||||
#:optional
|
||||
(command %diffoscope-command))
|
||||
"Run COMMAND to show the file-level differences for the mismatches in
|
||||
COMPARISON-REPORT."
|
||||
(call-with-mismatches comparison-report
|
||||
(lambda (directory1 directory2)
|
||||
(apply system*
|
||||
(append command
|
||||
(list directory1 directory2))))))
|
||||
|
||||
(define* (summarize-report comparison-report
|
||||
#:key
|
||||
(report-differences (const #f))
|
||||
(hash->string bytevector->nix-base32-string)
|
||||
verbose?)
|
||||
"Write to the current error port a summary of REPORT, a <comparison-report>
|
||||
object. When VERBOSE?, display matches in addition to mismatches and
|
||||
inconclusive reports."
|
||||
"Write to the current error port a summary of COMPARISON-REPORT, a
|
||||
<comparison-report> object. When VERBOSE?, display matches in addition to
|
||||
mismatches and inconclusive reports. Upon mismatch, call REPORT-DIFFERENCES
|
||||
with COMPARISON-REPORT."
|
||||
(define (report-hashes item local narinfos)
|
||||
(if local
|
||||
(report (G_ " local hash: ~a~%") (hash->string local))
|
||||
(report (G_ " no local build for '~a'~%") item))
|
||||
(for-each (lambda (narinfo)
|
||||
(report (G_ " ~50a: ~a~%")
|
||||
(uri->string (first (narinfo-uris narinfo)))
|
||||
(uri->string (narinfo-best-uri narinfo))
|
||||
(hash->string
|
||||
(narinfo-hash->sha256 (narinfo-hash narinfo)))))
|
||||
narinfos))
|
||||
|
|
@ -200,7 +381,8 @@ inconclusive reports."
|
|||
(match comparison-report
|
||||
(($ <comparison-report> item 'mismatch local (narinfos ...))
|
||||
(report (G_ "~a contents differ:~%") item)
|
||||
(report-hashes item local narinfos))
|
||||
(report-hashes item local narinfos)
|
||||
(report-differences comparison-report))
|
||||
(($ <comparison-report> item 'inconclusive #f narinfos)
|
||||
(warning (G_ "could not challenge '~a': no local build~%") item))
|
||||
(($ <comparison-report> item 'inconclusive locals ())
|
||||
|
|
@ -237,6 +419,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
|
|||
compare build results with those at URLS"))
|
||||
(display (G_ "
|
||||
-v, --verbose show details about successful comparisons"))
|
||||
(display (G_ "
|
||||
--diff=MODE show differences according to MODE"))
|
||||
(newline)
|
||||
(display (G_ "
|
||||
-h, --help display this help and exit"))
|
||||
|
|
@ -254,6 +438,22 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
|
|||
(lambda args
|
||||
(show-version-and-exit "guix challenge")))
|
||||
|
||||
(option '("diff") #t #f
|
||||
(lambda (opt name arg result . rest)
|
||||
(define mode
|
||||
(match arg
|
||||
("none" (const #t))
|
||||
("simple" report-differing-files)
|
||||
("diffoscope" report-differing-files/external)
|
||||
((and (? (cut string-prefix? "/" <>)) command)
|
||||
(cute report-differing-files/external <>
|
||||
(string-tokenize command)))
|
||||
(_ (leave (G_ "~a: unknown diff mode~%") arg))))
|
||||
|
||||
(apply values
|
||||
(alist-cons 'difference-report mode result)
|
||||
rest)))
|
||||
|
||||
(option '("substitute-urls") #t #f
|
||||
(lambda (opt name arg result . rest)
|
||||
(apply values
|
||||
|
|
@ -269,7 +469,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
|
|||
|
||||
(define %default-options
|
||||
`((system . ,(%current-system))
|
||||
(substitute-urls . ,%default-substitute-urls)))
|
||||
(substitute-urls . ,%default-substitute-urls)
|
||||
(difference-report . ,report-differing-files)))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
@ -286,12 +487,14 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
|
|||
opts))
|
||||
(system (assoc-ref opts 'system))
|
||||
(urls (assoc-ref opts 'substitute-urls))
|
||||
(diff (assoc-ref opts 'difference-report))
|
||||
(verbose? (assoc-ref opts 'verbose?)))
|
||||
(leave-on-EPIPE
|
||||
(with-store store
|
||||
;; Disable grafts since substitute servers normally provide only
|
||||
;; ungrafted stuff.
|
||||
(parameterize ((%graft? #f))
|
||||
(parameterize ((%graft? #f)
|
||||
(current-terminal-columns (terminal-columns)))
|
||||
(let ((files (match files
|
||||
(()
|
||||
(filter (cut locally-built? store <>)
|
||||
|
|
@ -305,7 +508,8 @@ Challenge the substitutes for PACKAGE... provided by one or more servers.\n"))
|
|||
(mlet* %store-monad ((items (mapm %store-monad
|
||||
ensure-store-item files))
|
||||
(reports (compare-contents items urls)))
|
||||
(for-each (cut summarize-report <> #:verbose? verbose?)
|
||||
(for-each (cut summarize-report <> #:verbose? verbose?
|
||||
#:report-differences diff)
|
||||
reports)
|
||||
(report "\n")
|
||||
(summarize-report-list reports)
|
||||
|
|
|
|||
|
|
@ -80,6 +80,7 @@
|
|||
narinfo-signature
|
||||
|
||||
narinfo-hash->sha256
|
||||
narinfo-best-uri
|
||||
|
||||
lookup-narinfos
|
||||
lookup-narinfos/diverse
|
||||
|
|
@ -822,35 +823,6 @@ was found."
|
|||
(= (string-length file) 32)))))
|
||||
(narinfo-cache-directories directory)))
|
||||
|
||||
(define (progress-report-port reporter port)
|
||||
"Return a port that continuously reports the bytes read from PORT using
|
||||
REPORTER, which should be a <progress-reporter> object."
|
||||
(match reporter
|
||||
(($ <progress-reporter> start report stop)
|
||||
(let* ((total 0)
|
||||
(read! (lambda (bv start count)
|
||||
(let ((n (match (get-bytevector-n! port bv start count)
|
||||
((? eof-object?) 0)
|
||||
(x x))))
|
||||
(set! total (+ total n))
|
||||
(report total)
|
||||
n))))
|
||||
(start)
|
||||
(make-custom-binary-input-port "progress-port-proc"
|
||||
read! #f #f
|
||||
(lambda ()
|
||||
;; XXX: Kludge! When used through
|
||||
;; 'decompressed-port', this port ends
|
||||
;; up being closed twice: once in a
|
||||
;; child process early on, and at the
|
||||
;; end in the parent process. Ignore
|
||||
;; the early close so we don't output
|
||||
;; a spurious "download-succeeded"
|
||||
;; trace.
|
||||
(unless (zero? total)
|
||||
(stop))
|
||||
(close-port port)))))))
|
||||
|
||||
(define-syntax with-networking
|
||||
(syntax-rules ()
|
||||
"Catch DNS lookup errors and TLS errors and gracefully exit."
|
||||
|
|
@ -913,7 +885,7 @@ expected by the daemon."
|
|||
(for-each (cute format #t "~a/~a~%" (%store-prefix) <>)
|
||||
(narinfo-references narinfo))
|
||||
|
||||
(let-values (((uri compression file-size) (select-uri narinfo)))
|
||||
(let-values (((uri compression file-size) (narinfo-best-uri narinfo)))
|
||||
(format #t "~a\n~a\n"
|
||||
(or file-size 0)
|
||||
(or (narinfo-size narinfo) 0))))
|
||||
|
|
@ -967,7 +939,7 @@ this is a rough approximation."
|
|||
(_ (or (string=? compression2 "none")
|
||||
(string=? compression2 "gzip")))))
|
||||
|
||||
(define (select-uri narinfo)
|
||||
(define (narinfo-best-uri narinfo)
|
||||
"Select the \"best\" URI to download NARINFO's nar, and return three values:
|
||||
the URI, its compression method (a string), and the compressed file size."
|
||||
(define choices
|
||||
|
|
@ -1008,7 +980,7 @@ DESTINATION as a nar file. Verify the substitute against ACL."
|
|||
store-item))
|
||||
|
||||
(let-values (((uri compression file-size)
|
||||
(select-uri narinfo)))
|
||||
(narinfo-best-uri narinfo)))
|
||||
;; Tell the daemon what the expected hash of the Nar itself is.
|
||||
(format #t "~a~%" (narinfo-hash narinfo))
|
||||
|
||||
|
|
|
|||
|
|
@ -48,6 +48,7 @@
|
|||
|
||||
write-file
|
||||
write-file-tree
|
||||
fold-archive
|
||||
restore-file))
|
||||
|
||||
;;; Comment:
|
||||
|
|
@ -198,24 +199,6 @@ substitute invalid byte sequences with question marks. This is a
|
|||
(put-bytevector out buf 0 read)
|
||||
(loop (- left read))))))))
|
||||
|
||||
(define (write-contents file p size)
|
||||
"Write SIZE bytes from FILE to output port P."
|
||||
(define (call-with-binary-input-file file proc)
|
||||
;; Open FILE as a binary file. This avoids scan-for-encoding, and thus
|
||||
;; avoids any initial buffering. Disable file name canonicalization to
|
||||
;; avoid stat'ing like crazy.
|
||||
(with-fluids ((%file-port-name-canonicalization #f))
|
||||
(let ((port (open-file file "rb")))
|
||||
(dynamic-wind
|
||||
(const #t)
|
||||
(cut proc port)
|
||||
(lambda ()
|
||||
(close-port port))))))
|
||||
|
||||
(call-with-binary-input-file file
|
||||
(lambda (input)
|
||||
(write-contents-from-port input p size))))
|
||||
|
||||
(define (write-contents-from-port input output size)
|
||||
"Write SIZE bytes from port INPUT to port OUTPUT."
|
||||
(write-string "contents" output)
|
||||
|
|
@ -226,38 +209,25 @@ substitute invalid byte sequences with question marks. This is a
|
|||
(dump input output size))
|
||||
(write-padding size output))
|
||||
|
||||
(define (read-contents in out)
|
||||
"Read the contents of a file from the Nar at IN, write it to OUT, and return
|
||||
the size in bytes."
|
||||
(define executable?
|
||||
(match (read-string in)
|
||||
("contents"
|
||||
#f)
|
||||
("executable"
|
||||
(match (list (read-string in) (read-string in))
|
||||
(("" "contents") #t)
|
||||
(x (raise
|
||||
(condition (&message
|
||||
(message "unexpected executable file marker"))
|
||||
(&nar-read-error (port in)
|
||||
(file #f)
|
||||
(token x))))))
|
||||
#t)
|
||||
(x
|
||||
(raise
|
||||
(condition (&message (message "unsupported nar file type"))
|
||||
(&nar-read-error (port in) (file #f) (token x)))))))
|
||||
|
||||
(let ((size (read-long-long in)))
|
||||
;; Note: `sendfile' cannot be used here because of port buffering on IN.
|
||||
(dump in out size)
|
||||
|
||||
(when executable?
|
||||
(chmod out #o755))
|
||||
(let ((m (modulo size 8)))
|
||||
(unless (zero? m)
|
||||
(get-bytevector-n* in (- 8 m))))
|
||||
size))
|
||||
(define (read-file-type port)
|
||||
"Read the file type tag from PORT, and return either 'regular or
|
||||
'executable."
|
||||
(match (read-string port)
|
||||
("contents"
|
||||
'regular)
|
||||
("executable"
|
||||
(match (list (read-string port) (read-string port))
|
||||
(("" "contents") 'executable)
|
||||
(x (raise
|
||||
(condition (&message
|
||||
(message "unexpected executable file marker"))
|
||||
(&nar-read-error (port port)
|
||||
(file #f)
|
||||
(token x)))))))
|
||||
(x
|
||||
(raise
|
||||
(condition (&message (message "unsupported nar file type"))
|
||||
(&nar-read-error (port port) (file #f) (token x)))))))
|
||||
|
||||
(define %archive-version-1
|
||||
;; Magic cookie for Nix archives.
|
||||
|
|
@ -383,9 +353,14 @@ which case you can use 'identity'."
|
|||
(define port-conversion-strategy
|
||||
(fluid->parameter %default-port-conversion-strategy))
|
||||
|
||||
(define (restore-file port file)
|
||||
"Read a file (possibly a directory structure) in Nar format from PORT.
|
||||
Restore it as FILE."
|
||||
(define (fold-archive proc seed port file)
|
||||
"Read a file (possibly a directory structure) in Nar format from PORT. Call
|
||||
PROC on each file or directory read from PORT using:
|
||||
|
||||
(PROC FILE TYPE CONTENTS RESULT)
|
||||
|
||||
using SEED as the first RESULT. TYPE is a symbol like 'regular, and CONTENTS
|
||||
depends on TYPE."
|
||||
(parameterize ((currently-restored-file file)
|
||||
|
||||
;; Error out if we can convert file names to the current
|
||||
|
|
@ -401,7 +376,8 @@ Restore it as FILE."
|
|||
(token signature)
|
||||
(file #f))))))
|
||||
|
||||
(let restore ((file file))
|
||||
(let read ((file file)
|
||||
(result seed))
|
||||
(define (read-eof-marker)
|
||||
(match (read-string port)
|
||||
(")" #t)
|
||||
|
|
@ -414,40 +390,49 @@ Restore it as FILE."
|
|||
|
||||
(match (list (read-string port) (read-string port) (read-string port))
|
||||
(("(" "type" "regular")
|
||||
(call-with-output-file file (cut read-contents port <>))
|
||||
(read-eof-marker))
|
||||
(let* ((type (read-file-type port))
|
||||
(size (read-long-long port))
|
||||
|
||||
;; The caller must read exactly SIZE bytes from PORT.
|
||||
(result (proc file type `(,port . ,size) result)))
|
||||
(let ((m (modulo size 8)))
|
||||
(unless (zero? m)
|
||||
(get-bytevector-n* port (- 8 m))))
|
||||
(read-eof-marker)
|
||||
result))
|
||||
(("(" "type" "symlink")
|
||||
(match (list (read-string port) (read-string port))
|
||||
(("target" target)
|
||||
(symlink target file)
|
||||
(read-eof-marker))
|
||||
(let ((result (proc file 'symlink target result)))
|
||||
(read-eof-marker)
|
||||
result))
|
||||
(x (raise
|
||||
(condition
|
||||
(&message (message "invalid symlink tokens"))
|
||||
(&nar-read-error (port port) (file file) (token x)))))))
|
||||
(("(" "type" "directory")
|
||||
(let ((dir file))
|
||||
(mkdir dir)
|
||||
(let loop ((prefix (read-string port)))
|
||||
(let loop ((prefix (read-string port))
|
||||
(result (proc file 'directory #f result)))
|
||||
(match prefix
|
||||
("entry"
|
||||
(match (list (read-string port)
|
||||
(read-string port) (read-string port)
|
||||
(read-string port))
|
||||
(("(" "name" file "node")
|
||||
(restore (string-append dir "/" file))
|
||||
(match (read-string port)
|
||||
(")" #t)
|
||||
(x
|
||||
(raise
|
||||
(condition
|
||||
(&message
|
||||
(message "unexpected directory entry termination"))
|
||||
(&nar-read-error (port port)
|
||||
(file file)
|
||||
(token x))))))
|
||||
(loop (read-string port)))))
|
||||
(")" #t) ; done with DIR
|
||||
(let ((result (read (string-append dir "/" file) result)))
|
||||
(match (read-string port)
|
||||
(")" #f)
|
||||
(x
|
||||
(raise
|
||||
(condition
|
||||
(&message
|
||||
(message "unexpected directory entry termination"))
|
||||
(&nar-read-error (port port)
|
||||
(file file)
|
||||
(token x))))))
|
||||
(loop (read-string port) result)))))
|
||||
(")" result) ;done with DIR
|
||||
(x
|
||||
(raise
|
||||
(condition
|
||||
|
|
@ -459,6 +444,27 @@ Restore it as FILE."
|
|||
(&message (message "unsupported nar entry type"))
|
||||
(&nar-read-error (port port) (file file) (token x)))))))))
|
||||
|
||||
(define (restore-file port file)
|
||||
"Read a file (possibly a directory structure) in Nar format from PORT.
|
||||
Restore it as FILE."
|
||||
(fold-archive (lambda (file type content result)
|
||||
(match type
|
||||
('directory
|
||||
(mkdir file))
|
||||
('symlink
|
||||
(symlink content file))
|
||||
((or 'regular 'executable)
|
||||
(match content
|
||||
((input . size)
|
||||
(call-with-output-file file
|
||||
(lambda (output)
|
||||
(dump input output size)
|
||||
(when (eq? type 'executable)
|
||||
(chmod output #o755)))))))))
|
||||
#t
|
||||
port
|
||||
file))
|
||||
|
||||
;;; Local Variables:
|
||||
;;; eval: (put 'call-with-binary-input-file 'scheme-indent-function 1)
|
||||
;;; End:
|
||||
|
|
|
|||
|
|
@ -65,14 +65,14 @@ needed."
|
|||
(close-port socket)
|
||||
#t)))
|
||||
|
||||
(define (%local-url)
|
||||
(define* (%local-url #:optional (port (%http-server-port)))
|
||||
;; URL to use for 'home-page' tests.
|
||||
(string-append "http://localhost:" (number->string (%http-server-port))
|
||||
(string-append "http://localhost:" (number->string port)
|
||||
"/foo/bar"))
|
||||
|
||||
(define* (call-with-http-server responses+data thunk)
|
||||
"Call THUNK with an HTTP server running and returning RESPONSES+DATA on HTTP
|
||||
requests. Each elements of RESPONSES+DATA must be a tuple containing a
|
||||
requests. Each element of RESPONSES+DATA must be a tuple containing a
|
||||
response and a string, or an HTTP response code and a string."
|
||||
(define responses
|
||||
(map (match-lambda
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2015, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2015, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
|
@ -18,22 +18,33 @@
|
|||
|
||||
(define-module (test-challenge)
|
||||
#:use-module (guix tests)
|
||||
#:use-module (guix tests http)
|
||||
#:use-module (gcrypt hash)
|
||||
#:use-module (guix store)
|
||||
#:use-module (guix monads)
|
||||
#:use-module (guix derivations)
|
||||
#:use-module (guix serialization)
|
||||
#:use-module (guix packages)
|
||||
#:use-module (guix gexp)
|
||||
#:use-module (guix base32)
|
||||
#:use-module (guix scripts challenge)
|
||||
#:use-module (guix scripts substitute)
|
||||
#:use-module ((guix build utils) #:select (find-files))
|
||||
#:use-module (gnu packages bootstrap)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-26)
|
||||
#:use-module (srfi srfi-64)
|
||||
#:use-module (rnrs bytevectors)
|
||||
#:use-module (rnrs io ports)
|
||||
#:use-module (ice-9 match))
|
||||
|
||||
(define query-path-hash*
|
||||
(store-lift query-path-hash))
|
||||
|
||||
(define (query-path-size item)
|
||||
(mlet %store-monad ((info (query-path-info* item)))
|
||||
(return (path-info-nar-size info))))
|
||||
|
||||
(define* (call-with-derivation-narinfo* drv thunk hash)
|
||||
(lambda (store)
|
||||
(with-derivation-narinfo drv (sha256 => hash)
|
||||
|
|
@ -138,7 +149,90 @@
|
|||
(bytevector=? (narinfo-hash->sha256
|
||||
(narinfo-hash narinfo))
|
||||
hash))))))))))))
|
||||
(define (make-narinfo item size hash)
|
||||
(format #f "StorePath: ~a
|
||||
Compression: none
|
||||
URL: nar/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo
|
||||
NarSize: ~d
|
||||
NarHash: sha256:~a
|
||||
References: ~%" item size (bytevector->nix-base32-string hash)))
|
||||
|
||||
(define (call-mismatch-test proc)
|
||||
"Pass PROC a <comparison-report> for a mismatch and return its return
|
||||
value."
|
||||
|
||||
;; Pretend we have two different results for the same store item, ITEM, with
|
||||
;; "/bin/guile" differing between the two nars.
|
||||
(mlet* %store-monad
|
||||
((drv1 (package->derivation %bootstrap-guile))
|
||||
(drv2 (gexp->derivation
|
||||
"broken-guile"
|
||||
(with-imported-modules '((guix build utils))
|
||||
#~(begin
|
||||
(use-modules (guix build utils))
|
||||
(copy-recursively #$drv1 #$output)
|
||||
(chmod (string-append #$output "/bin/guile")
|
||||
#o755)
|
||||
(call-with-output-file (string-append
|
||||
#$output
|
||||
"/bin/guile")
|
||||
(lambda (port)
|
||||
(display "corrupt!" port)))))))
|
||||
(out1 -> (derivation->output-path drv1))
|
||||
(out2 -> (derivation->output-path drv2))
|
||||
(item -> (string-append (%store-prefix) "/"
|
||||
(bytevector->nix-base32-string
|
||||
(random-bytevector 32))
|
||||
"-foo"
|
||||
(number->string (current-time) 16))))
|
||||
(mbegin %store-monad
|
||||
(built-derivations (list drv1 drv2))
|
||||
(mlet* %store-monad ((size1 (query-path-size out1))
|
||||
(size2 (query-path-size out2))
|
||||
(hash1 (query-path-hash* out1))
|
||||
(hash2 (query-path-hash* out2))
|
||||
(nar1 -> (call-with-bytevector-output-port
|
||||
(lambda (port)
|
||||
(write-file out1 port))))
|
||||
(nar2 -> (call-with-bytevector-output-port
|
||||
(lambda (port)
|
||||
(write-file out2 port)))))
|
||||
(parameterize ((%http-server-port 9000))
|
||||
(with-http-server `((200 ,(make-narinfo item size1 hash1))
|
||||
(200 ,nar1))
|
||||
(parameterize ((%http-server-port 9001))
|
||||
(with-http-server `((200 ,(make-narinfo item size2 hash2))
|
||||
(200 ,nar2))
|
||||
(mlet* %store-monad ((urls -> (list (%local-url 9000)
|
||||
(%local-url 9001)))
|
||||
(reports (compare-contents (list item)
|
||||
urls)))
|
||||
(pk 'report reports)
|
||||
(return (proc (car reports))))))))))))
|
||||
|
||||
(test-assertm "differing-files"
|
||||
(call-mismatch-test
|
||||
(lambda (report)
|
||||
(equal? (differing-files report) '("/bin/guile")))))
|
||||
|
||||
(test-assertm "call-with-mismatches"
|
||||
(call-mismatch-test
|
||||
(lambda (report)
|
||||
(call-with-mismatches
|
||||
report
|
||||
(lambda (directory1 directory2)
|
||||
(let* ((files1 (find-files directory1))
|
||||
(files2 (find-files directory2))
|
||||
(files (map (cute string-drop <> (string-length directory1))
|
||||
files1)))
|
||||
(and (equal? files
|
||||
(map (cute string-drop <> (string-length directory2))
|
||||
files2))
|
||||
(equal? (remove (lambda (file)
|
||||
(file=? (string-append directory1 "/" file)
|
||||
(string-append directory2 "/" file)))
|
||||
files)
|
||||
'("/bin/guile")))))))))
|
||||
|
||||
(test-end)
|
||||
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
# GNU Guix --- Functional package management for GNU
|
||||
# Copyright © 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||
# Copyright © 2013, 2014, 2015, 2019 Ludovic Courtès <ludo@gnu.org>
|
||||
#
|
||||
# This file is part of GNU Guix.
|
||||
#
|
||||
|
|
@ -74,5 +74,10 @@ guix archive -x "$tmpdir" < "$archive"
|
|||
test -x "$tmpdir/bin/guile"
|
||||
test -d "$tmpdir/lib/guile"
|
||||
|
||||
# Check '--list'.
|
||||
guix archive -t < "$archive" | grep "^D /share/guile"
|
||||
guix archive -t < "$archive" | grep "^x /bin/guile"
|
||||
guix archive -t < "$archive" | grep "^r /share/guile.*/boot-9\.scm"
|
||||
|
||||
if echo foo | guix archive --authorize
|
||||
then false; else true; fi
|
||||
|
|
|
|||
|
|
@ -214,6 +214,80 @@
|
|||
(lambda ()
|
||||
(false-if-exception (rm-rf %test-dir))))))
|
||||
|
||||
(test-equal "write-file-tree + fold-archive"
|
||||
'(("R" directory #f)
|
||||
("R/dir" directory #f)
|
||||
("R/dir/exe" executable "1234")
|
||||
("R/foo" regular "abcdefg")
|
||||
("R/lnk" symlink "foo"))
|
||||
|
||||
(let ()
|
||||
(define-values (port get-bytevector)
|
||||
(open-bytevector-output-port))
|
||||
(write-file-tree "root" port
|
||||
#:file-type+size
|
||||
(match-lambda
|
||||
("root"
|
||||
(values 'directory 0))
|
||||
("root/foo"
|
||||
(values 'regular 7))
|
||||
("root/lnk"
|
||||
(values 'symlink 0))
|
||||
("root/dir"
|
||||
(values 'directory 0))
|
||||
("root/dir/exe"
|
||||
(values 'executable 4)))
|
||||
#:file-port
|
||||
(match-lambda
|
||||
("root/foo" (open-input-string "abcdefg"))
|
||||
("root/dir/exe" (open-input-string "1234")))
|
||||
#:symlink-target
|
||||
(match-lambda
|
||||
("root/lnk" "foo"))
|
||||
#:directory-entries
|
||||
(match-lambda
|
||||
("root" '("foo" "dir" "lnk"))
|
||||
("root/dir" '("exe"))))
|
||||
(close-port port)
|
||||
|
||||
(reverse
|
||||
(fold-archive (lambda (file type contents result)
|
||||
(let ((contents (if (memq type '(regular executable))
|
||||
(utf8->string
|
||||
(get-bytevector-n (car contents)
|
||||
(cdr contents)))
|
||||
contents)))
|
||||
(cons `(,file ,type ,contents)
|
||||
result)))
|
||||
'()
|
||||
(open-bytevector-input-port (get-bytevector))
|
||||
"R"))))
|
||||
|
||||
(test-equal "write-file-tree + fold-archive, flat file"
|
||||
'(("R" regular "abcdefg"))
|
||||
|
||||
(let ()
|
||||
(define-values (port get-bytevector)
|
||||
(open-bytevector-output-port))
|
||||
(write-file-tree "root" port
|
||||
#:file-type+size
|
||||
(match-lambda
|
||||
("root" (values 'regular 7)))
|
||||
#:file-port
|
||||
(match-lambda
|
||||
("root" (open-input-string "abcdefg"))))
|
||||
(close-port port)
|
||||
|
||||
(reverse
|
||||
(fold-archive (lambda (file type contents result)
|
||||
(let ((contents (utf8->string
|
||||
(get-bytevector-n (car contents)
|
||||
(cdr contents)))))
|
||||
(cons `(,file ,type ,contents) result)))
|
||||
'()
|
||||
(open-bytevector-input-port (get-bytevector))
|
||||
"R"))))
|
||||
|
||||
(test-assert "write-file supports non-file output ports"
|
||||
(let ((input (string-append (dirname (search-path %load-path "guix.scm"))
|
||||
"/guix"))
|
||||
|
|
|
|||
Reference in New Issue