1 files changed, 58 insertions(+), 0 deletions(-)

M tests/store.scm

@@ 374,6 374,64 @@ Deriver: ~a~%"
          (build-derivations s (list d))
          (equal? c (call-with-input-file o get-string-all)))))
 
+(test-assert "substitute, corrupt output hash"
+  ;; Tweak the substituter into installing a substitute whose hash doesn't
+  ;; match the one announced in the narinfo.  The daemon must notice this and
+  ;; raise an error.
+  (let* ((s   (open-connection))
+         (c   "hello, world")                     ; contents of the output
+         (d   (build-expression->derivation
+               s "corrupt-substitute"
+               `(mkdir %output)
+               #:guile-for-build
+               (package-derivation s %bootstrap-guile (%current-system))))
+         (o   (derivation->output-path d))
+         (dir (and=> (getenv "GUIX_BINARY_SUBSTITUTE_URL")
+                     (compose uri-path string->uri))))
+    ;; Create fake substituter data, to be read by `substitute-binary'.
+    (call-with-output-file (string-append dir "/nix-cache-info")
+      (lambda (p)
+        (format p "StoreDir: ~a\nWantMassQuery: 0\n"
+                (%store-prefix))))
+    (call-with-output-file (string-append dir "/example.out")
+      (lambda (p)
+        (display "The contents here do not match C." p)))
+    (call-with-output-file (string-append dir "/example.nar")
+      (lambda (p)
+        (write-file (string-append dir "/example.out") p)))
+    (call-with-output-file (string-append dir "/" (store-path-hash-part o)
+                                          ".narinfo")
+      (lambda (p)
+        (format p "StorePath: ~a
+URL: ~a
+Compression: none
+NarSize: 1234
+NarHash: sha256:~a
+References: 
+System: ~a
+Deriver: ~a~%"
+                o                                   ; StorePath
+                "example.nar"                       ; relative URL
+                (bytevector->nix-base32-string
+                 (sha256 (string->utf8 c)))
+                (%current-system)                   ; System
+                (basename
+                 (derivation-file-name d)))))       ; Deriver
+
+    ;; Make sure we use `substitute-binary'.
+    (set-build-options s
+                       #:use-substitutes? #t
+                       #:fallback? #f)
+    (and (has-substitutes? s o)
+         (guard (c ((nix-protocol-error? c)
+                    ;; XXX: the daemon writes "hash mismatch in downloaded
+                    ;; path", but the actual error returned to the client
+                    ;; doesn't mention that.
+                    (pk 'corrupt c)
+                    (not (zero? (nix-protocol-error-status c)))))
+           (build-derivations s (list d))
+           #f))))
+
 (test-assert "substitute --fallback"
   (let* ((s   (open-connection))
          (t   (random-text))                      ; contents of the output