aboutsummaryrefslogtreecommitdiff
path: root/gnu/packages/ed.scm
blob: a42ba401024b2fb67741fc138a60d6febbd18954 (about) (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2012 Nikita Karetnikov <nikita@karetnikov.org>
;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2016, 2019 Efraim Flashner <efraim@flashner.co.il>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.

(define-module (gnu packages ed)
  #:use-module (guix licenses)
  #:use-module (guix packages)
  #:use-module (guix download)
  #:use-module (guix build-system gnu)
  #:use-module (gnu packages compression))

(define-public ed
  (package
    (name "ed")
    (version "1.17")
    (source (origin
             (method url-fetch)
             (uri (string-append "mirror://gnu/ed/ed-"
                                 version ".tar.lz"))
             (sha256
              (base32
               "0m2yrkfjjraakxr98nsiakqrn351h99n706x9asgmdi57j43kpki"))))
    (build-system gnu-build-system)
    (native-inputs (list lzip))
    (arguments
     '(#:configure-flags '("CC=gcc")
       #:phases
       (modify-phases %standard-phases
         (add-before 'patch-source-shebangs 'patch-test-suite
                     (lambda _
                       (substitute* "testsuite/check.sh"
                         (("/bin/sh") (which "sh")))
                       #t)))))
    (home-page "https://www.gnu.org/software/ed/")
    (synopsis "Line-oriented text editor")
    (description
     "Ed is a line-oriented text editor: rather than offering an overview of
a document, ed performs editing one line at a time.  It can be executed both
interactively and via shell scripts.  Its method of command input allows
complex tasks to be performed in an automated way.  GNU ed offers several
extensions over the standard utility.")
    (license gpl3+)))
)) (define %main-substitute-directory ;; The place where 'call-with-narinfo' stores its data by default. (uri-path (string->uri (getenv "GUIX_BINARY_SUBSTITUTE_URL")))) (define %alternate-substitute-directory ;; Another place. (string-append (dirname %main-substitute-directory) "/substituter-alt-data")) (define %unroutable-substitute-url ;; Substitute URL with an unroutable server address, as per ;; <https://www.rfc-editor.org/rfc/rfc5737>. "http://203.0.113.1") (define %narinfo ;; Skeleton of the narinfo used below. (string-append "StorePath: " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo URL: example.nar Compression: none NarHash: sha256:" (bytevector->nix-base32-string (sha256 (string->utf8 "Substitutable data."))) " NarSize: 42 References: bar baz Deriver: " (%store-prefix) "/foo.drv System: mips64el-linux\n")) (define* (call-with-narinfo narinfo thunk #:optional (narinfo-directory %main-substitute-directory)) "Call THUNK in a context where the directory at URL is populated with a file for NARINFO." (mkdir-p narinfo-directory) (let ((cache-directory (string-append (getenv "XDG_CACHE_HOME") "/guix/substitute/"))) (dynamic-wind (lambda () (when (file-exists? cache-directory) (delete-file-recursively cache-directory)) (call-with-output-file (string-append narinfo-directory "/nix-cache-info") (lambda (port) (format port "StoreDir: ~a\nWantMassQuery: 0\n" (%store-prefix)))) (call-with-output-file (string-append narinfo-directory "/" "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ".narinfo") (cut display narinfo <>)) ;; Prepare the nar. (call-with-output-file (string-append narinfo-directory "/example.out") (cut display "Substitutable data." <>)) (call-with-output-file (string-append narinfo-directory "/example.nar") (cute write-file (string-append narinfo-directory "/example.out") <>)) (%allow-unauthenticated-substitutes? #f)) thunk (lambda () (when (file-exists? cache-directory) (delete-file-recursively cache-directory)))))) (define-syntax-rule (with-narinfo narinfo body ...) (call-with-narinfo narinfo (lambda () body ...))) (define-syntax-rule (with-narinfo* narinfo directory body ...) (call-with-narinfo narinfo (lambda () body ...) directory)) ;; Transmit these options to 'guix substitute'. (substitute-urls (list (getenv "GUIX_BINARY_SUBSTITUTE_URL"))) ;; Never use file descriptor 4, unlike what happens when invoked by the ;; daemon. (%reply-file-descriptor #f) (test-equal "query narinfo without signature" "" ; not substitutable (with-narinfo %narinfo (string-trim-both (with-output-to-string (lambda () (with-input-from-string (string-append "have " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (lambda () (guix-substitute "--query")))))))) (test-equal "query narinfo with invalid hash" ;; The hash in the signature differs from the hash of %NARINFO. "" (with-narinfo (string-append %narinfo "Signature: " (signature-field "different body") "\n") (string-trim-both (with-output-to-string (lambda () (with-input-from-string (string-append "have " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (lambda () (guix-substitute "--query")))))))) (test-equal "query narinfo with signature over nothing" ;; The signature is computed over the empty string, not over the important ;; parts, so the narinfo must be ignored. "" (with-narinfo (string-append "Signature: " (signature-field "") "\n" %narinfo "\n") (string-trim-both (with-output-to-string (lambda () (with-input-from-string (string-append "have " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (lambda () (guix-substitute "--query")))))))) (test-equal "query narinfo with signature over irrelevant bits" ;; The signature is valid but it does not cover the ;; StorePath/NarHash/References tuple and is thus irrelevant; the narinfo ;; must be ignored. "" (let ((prefix (string-append "StorePath: " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo URL: example.nar Compression: none\n"))) (with-narinfo (string-append prefix "Signature: " (signature-field prefix) " NarHash: sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa NarSize: 42 References: bar baz Deriver: " (%store-prefix) "/foo.drv System: mips64el-linux\n") (string-trim-both (with-output-to-string (lambda () (with-input-from-string (string-append "have " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (lambda () (guix-substitute "--query"))))))))) (test-equal "query narinfo with signature over relevant subset" ;; The signature covers the StorePath/NarHash/References tuple, so it is ;; valid; it does not cover non-normative fields, which is fine. (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (let ((prefix (string-append "StorePath: " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo NarHash: sha256:aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa References: bar baz\n"))) (with-narinfo (string-append prefix "Signature: " (signature-field prefix) " URL: example.nar Compression: none NarSize: 42 Deriver: " (%store-prefix) "/foo.drv") (string-trim-both (with-output-to-string (lambda () (with-input-from-string (string-append "have " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (lambda () (guix-substitute "--query"))))))))) (test-equal "query narinfo signed with authorized key" (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (with-narinfo (string-append %narinfo "Signature: " (signature-field %narinfo) "\n") (string-trim-both (with-output-to-string (lambda () (with-input-from-string (string-append "have " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (lambda () (guix-substitute "--query")))))))) (test-equal "query narinfo signed with authorized key, unroutable URL first" (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (with-narinfo (string-append %narinfo "Signature: " (signature-field %narinfo) "\n") (string-trim-both (with-output-to-string (lambda () (with-input-from-string (string-append "have " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (lambda () (parameterize ((substitute-urls (list %unroutable-substitute-url (string-append "file://" %main-substitute-directory)))) (guix-substitute "--query"))))))))) (test-equal "query narinfo signed with unauthorized key" "" ; not substitutable (with-narinfo (string-append %narinfo "Signature: " (signature-field %narinfo #:public-key %wrong-public-key) "\n") (string-trim-both (with-output-to-string (lambda () (with-input-from-string (string-append "have " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") (lambda () (guix-substitute "--query")))))))) (test-quit "substitute, no signature" "no valid substitute" (with-narinfo %narinfo (with-input-from-string (string-append "substitute " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo" " foo\n") (lambda () (guix-substitute "--substitute"))))) (test-quit "substitute, invalid narinfo hash" "no valid substitute" ;; The hash in the signature differs from the hash of %NARINFO. (with-narinfo (string-append %narinfo "Signature: " (signature-field "different body") "\n") (with-input-from-string (string-append "substitute " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo" " foo\n") (lambda () (guix-substitute "--substitute"))))) (test-equal "substitute, invalid hash" (string-append "hash-mismatch sha256 " (bytevector->nix-base32-string (sha256 #vu8())) " " (let-values (((port get-hash) (open-hash-port (hash-algorithm sha256))) ((content) "Substitutable data.")) (write-file-tree "foo" port #:file-type+size (lambda _ (values 'regular (string-length content))) #:file-port (lambda _ (open-input-string content))) (close-port port) (bytevector->nix-base32-string (get-hash))) "\n") ;; Arrange so the actual data hash does not match the 'NarHash' field in the ;; narinfo. (with-output-to-string (lambda () (let ((narinfo (string-append "StorePath: " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-wrong-hash URL: example.nar Compression: none NarHash: sha256:" (bytevector->nix-base32-string (sha256 #vu8())) " NarSize: 42 References: Deriver: " (%store-prefix) "/foo.drv System: mips64el-linux\n"))) (with-narinfo (string-append narinfo "Signature: " (signature-field narinfo) "\n") (call-with-temporary-directory (lambda (directory) (with-input-from-string (string-append "substitute " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-wrong-hash " directory "/wrong-hash\n") (lambda () (guix-substitute "--substitute")))))))))) (test-quit "substitute, unauthorized key" "no valid substitute" (with-narinfo (string-append %narinfo "Signature: " (signature-field %narinfo #:public-key %wrong-public-key) "\n") (with-input-from-string (string-append "substitute " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo" " foo\n") (lambda () (guix-substitute "--substitute"))))) (test-equal "substitute, authorized key" '("Substitutable data." 1 #o444) (with-narinfo (string-append %narinfo "Signature: " (signature-field %narinfo)) (dynamic-wind (const #t) (lambda () (request-substitution (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved") (list (call-with-input-file "substitute-retrieved" get-string-all) (stat:mtime (lstat "substitute-retrieved")) (stat:perms (lstat "substitute-retrieved")))) (lambda () (false-if-exception (delete-file "substitute-retrieved")))))) (test-equal "substitute, authorized key, first substitute URL is unroutable" '("Substitutable data." 1 #o444) (with-narinfo (string-append %narinfo "Signature: " (signature-field %narinfo)) (dynamic-wind (const #t) (lambda () ;; Pick an unroutable URL as the first one. This shouldn't be a ;; problem. (parameterize ((substitute-urls (list %unroutable-substitute-url (string-append "file://" %main-substitute-directory)))) (request-substitution (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved") (list (call-with-input-file "substitute-retrieved" get-string-all) (stat:mtime (lstat "substitute-retrieved")) (stat:perms (lstat "substitute-retrieved"))))) (lambda () (false-if-exception (delete-file "substitute-retrieved")))))) (test-equal "substitute, unauthorized narinfo comes first" "Substitutable data." (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo #:public-key %wrong-public-key)) %alternate-substitute-directory (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo)) %main-substitute-directory (dynamic-wind (const #t) (lambda () ;; Remove this file so that the substitute can only be retrieved ;; from %ALTERNATE-SUBSTITUTE-DIRECTORY. (delete-file (string-append %main-substitute-directory "/example.nar")) (parameterize ((substitute-urls (map (cut string-append "file://" <>) (list %alternate-substitute-directory %main-substitute-directory)))) (request-substitution (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved")) (call-with-input-file "substitute-retrieved" get-string-all)) (lambda () (false-if-exception (delete-file "substitute-retrieved"))))))) (test-equal "substitute, unsigned narinfo comes first" "Substitutable data." (with-narinfo* %narinfo ;not signed! %alternate-substitute-directory (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo)) %main-substitute-directory (dynamic-wind (const #t) (lambda () ;; Remove this file so that the substitute can only be retrieved ;; from %ALTERNATE-SUBSTITUTE-DIRECTORY. (delete-file (string-append %main-substitute-directory "/example.nar")) (parameterize ((substitute-urls (map (cut string-append "file://" <>) (list %alternate-substitute-directory %main-substitute-directory)))) (request-substitution (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved")) (call-with-input-file "substitute-retrieved" get-string-all)) (lambda () (false-if-exception (delete-file "substitute-retrieved"))))))) (test-equal "substitute, first URL has narinfo but lacks nar, second URL unauthorized" "Substitutable data." (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo #:public-key %wrong-public-key)) %alternate-substitute-directory (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo)) %main-substitute-directory (dynamic-wind (const #t) (lambda () ;; Remove this file so that the substitute can only be retrieved ;; from %ALTERNATE-SUBSTITUTE-DIRECTORY. (delete-file (string-append %main-substitute-directory "/example.nar")) (parameterize ((substitute-urls (map (cut string-append "file://" <>) (list %main-substitute-directory %alternate-substitute-directory)))) (request-substitution (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved")) (call-with-input-file "substitute-retrieved" get-string-all)) (lambda () (false-if-exception (delete-file "substitute-retrieved"))))))) (test-equal "substitute, first URL has narinfo but nar is 404, both URLs authorized" "Substitutable data." (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo)) %main-substitute-directory (with-http-server `((200 ,(string-append %narinfo "Signature: " (signature-field %narinfo))) (404 "Sorry, nar is missing!")) (dynamic-wind (const #t) (lambda () (parameterize ((substitute-urls (list (%local-url) (string-append "file://" %main-substitute-directory)))) (request-substitution (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved")) (call-with-input-file "substitute-retrieved" get-string-all)) (lambda () (false-if-exception (delete-file "substitute-retrieved"))))))) (test-equal "substitute, first URL has narinfo but nar is 404, one URL authorized" "Substitutable data." (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo #:public-key %wrong-public-key)) %main-substitute-directory (with-http-server `((200 ,(string-append %narinfo "Signature: " (signature-field %narinfo #:public-key %wrong-public-key))) (404 "Sorry, nar is missing!")) (let ((url1 (%local-url))) (parameterize ((%http-server-port 0)) (with-http-server `((200 ,(string-append %narinfo "Signature: " (signature-field %narinfo))) (404 "Sorry, nar is missing!")) (let ((url2 (%local-url))) (dynamic-wind (const #t) (lambda () (parameterize ((substitute-urls (list url1 url2 (string-append "file://" %main-substitute-directory)))) (request-substitution (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved")) (call-with-input-file "substitute-retrieved" get-string-all)) (lambda () (false-if-exception (delete-file "substitute-retrieved"))))))))))) (test-equal "substitute, preferred nar URL is 404, other is 200" "Substitutable data." (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo)) %main-substitute-directory (with-http-server `((200 ,(string-append %narinfo "Signature: " (signature-field %narinfo) "\n" "URL: example.nar.lz\n" "Compression: lzip\n")) (404 "Sorry, nar.lz is missing!") (200 ,(call-with-input-file (string-append %main-substitute-directory "/example.nar") get-bytevector-all))) (dynamic-wind (const #t) (lambda () (parameterize ((substitute-urls (list (%local-url)))) (request-substitution (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved")) (call-with-input-file "substitute-retrieved" get-string-all)) (lambda () (false-if-exception (delete-file "substitute-retrieved"))))))) (test-equal "substitute, previous partial download around" "Substitutable data." (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo)) %main-substitute-directory (with-http-server `((200 ,(string-append %narinfo "Signature: " (signature-field %narinfo))) (200 ,(call-with-input-file (string-append %main-substitute-directory "/example.nar") get-bytevector-all))) (dynamic-wind (const #t) (lambda () (parameterize ((substitute-urls (list (%local-url)))) (mkdir-p "substitute-retrieved/a/b/c/d") ;add stale data (request-substitution (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved")) (call-with-input-file "substitute-retrieved" get-string-all)) (lambda () (false-if-exception (delete-file "substitute-retrieved"))))))) (test-equal "substitute, narinfo is available but nar is missing" "not-found\n" (let ((port (open-output-string))) (parameterize ((current-output-port port)) (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo #:public-key %wrong-public-key)) %main-substitute-directory (with-http-server `((200 ,(string-append %narinfo "Signature: " (signature-field %narinfo))) (404 "Sorry, nar is missing!")) (parameterize ((substitute-urls (list (%local-url) (string-append "file://" %main-substitute-directory)))) (delete-file (string-append %main-substitute-directory "/example.nar")) (request-substitution (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved") (and (not (file-exists? "substitute-retrieved")) (get-output-string port)))))))) (test-equal "substitute, first narinfo is unsigned and has wrong hash" "Substitutable data." (with-narinfo* (regexp-substitute #f (string-match "NarHash: [[:graph:]]+" %narinfo) 'pre "NarHash: sha256:" (bytevector->nix-base32-string (make-bytevector 32)) 'post) %alternate-substitute-directory (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo)) %main-substitute-directory (dynamic-wind (const #t) (lambda () ;; This time remove the file so that the substitute can only be ;; retrieved from %MAIN-SUBSTITUTE-DIRECTORY. (delete-file (string-append %alternate-substitute-directory "/example.nar")) (parameterize ((substitute-urls (map (cut string-append "file://" <>) (list %alternate-substitute-directory %main-substitute-directory)))) (request-substitution (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved")) (call-with-input-file "substitute-retrieved" get-string-all)) (lambda () (false-if-exception (delete-file "substitute-retrieved"))))))) (test-equal "substitute, first narinfo is unsigned and has wrong refs" "Substitutable data." (with-narinfo* (regexp-substitute #f (string-match "References: ([^\n]+)\n" %narinfo) 'pre "References: " 1 " wrong set of references\n" 'post) %alternate-substitute-directory (with-narinfo* (string-append %narinfo "Signature: " (signature-field %narinfo)) %main-substitute-directory (dynamic-wind (const #t) (lambda () ;; This time remove the file so that the substitute can only be ;; retrieved from %MAIN-SUBSTITUTE-DIRECTORY. (delete-file (string-append %alternate-substitute-directory "/example.nar")) (parameterize ((substitute-urls (map (cut string-append "file://" <>) (list %alternate-substitute-directory %main-substitute-directory)))) (request-substitution (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved")) (call-with-input-file "substitute-retrieved" get-string-all)) (lambda () (false-if-exception (delete-file "substitute-retrieved"))))))) (test-quit "substitute, two invalid narinfos" "no valid substitute" (with-narinfo* %narinfo ;not signed %alternate-substitute-directory (with-narinfo* (string-append %narinfo "Signature: " ;unauthorized (signature-field %narinfo #:public-key %wrong-public-key)) %main-substitute-directory (with-input-from-string (string-append "substitute " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo" " substitute-retrieved\n") (lambda () (guix-substitute "--substitute")))))) (test-equal "substitute, narinfo with several URLs" "Substitutable data." (let ((narinfo (string-append "StorePath: " (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo URL: example.nar.gz Compression: gzip URL: example.nar.lz Compression: lzip URL: example.nar Compression: none NarHash: sha256:" (bytevector->nix-base32-string (sha256 (string->utf8 "Substitutable data."))) " NarSize: 42 References: bar baz Deriver: " (%store-prefix) "/foo.drv System: mips64el-linux\n"))) (with-narinfo (string-append narinfo "Signature: " (signature-field narinfo)) (dynamic-wind (const #t) (lambda () (define (compress input output compression) (call-with-output-file output (lambda (port) (call-with-compressed-output-port compression port (lambda (port) (call-with-input-file input (lambda (input) (dump-port input port)))))))) (let ((nar (string-append %main-substitute-directory "/example.nar"))) (compress nar (string-append nar ".gz") 'gzip) (compress nar (string-append nar ".lz") 'lzip)) (parameterize ((substitute-urls (list (string-append "file://" %main-substitute-directory)))) (request-substitution (string-append (%store-prefix) "/aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa-foo") "substitute-retrieved")) (call-with-input-file "substitute-retrieved" get-string-all)) (lambda () (false-if-exception (delete-file "substitute-retrieved"))))))) (test-end "substitute") ;;; Local Variables: ;;; eval: (put 'with-narinfo 'scheme-indent-function 1) ;;; eval: (put 'with-narinfo* 'scheme-indent-function 2) ;;; eval: (put 'test-quit 'scheme-indent-function 2) ;;; End: