tests/publish.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2015 David Thompson <davet@gnu.org>
   3 ;;; Copyright © 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
   4 ;;;
   5 ;;; This file is part of GNU Guix.
   6 ;;;
   7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   8 ;;; under the terms of the GNU General Public License as published by
   9 ;;; the Free Software Foundation; either version 3 of the License, or (at
  10 ;;; your option) any later version.
  11 ;;;
  12 ;;; GNU Guix is distributed in the hope that it will be useful, but
  13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 ;;; GNU General Public License for more details.
  16 ;;;
  17 ;;; You should have received a copy of the GNU General Public License
  18 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 ;; Avoid interference.
  21 (unsetenv "http_proxy")
  22
  23 (define-module (test-publish)
  24   #:use-module (guix scripts publish)
  25   #:use-module (guix tests)
  26   #:use-module (guix config)
  27   #:use-module (guix utils)
  28   #:use-module (gcrypt hash)
  29   #:use-module (guix store)
  30   #:use-module (guix derivations)
  31   #:use-module (guix gexp)
  32   #:use-module (guix base32)
  33   #:use-module (guix base64)
  34   #:use-module ((guix records) #:select (recutils->alist))
  35   #:use-module ((guix serialization) #:select (restore-file))
  36   #:use-module (gcrypt pk-crypto)
  37   #:use-module ((guix pki) #:select (%public-key-file %private-key-file))
  38   #:use-module (guix zlib)
  39   #:use-module (guix lzlib)
  40   #:use-module (web uri)
  41   #:use-module (web client)
  42   #:use-module (web response)
  43   #:use-module (rnrs bytevectors)
  44   #:use-module (ice-9 binary-ports)
  45   #:use-module (srfi srfi-1)
  46   #:use-module (srfi srfi-26)
  47   #:use-module (srfi srfi-64)
  48   #:use-module (ice-9 format)
  49   #:use-module (ice-9 match)
  50   #:use-module (ice-9 rdelim))
  51
  52 (define %store
  53   (open-connection-for-tests))
  54
  55 (define %reference (add-text-to-store %store "ref" "foo"))
  56
  57 (define %item (add-text-to-store %store "item" "bar" (list %reference)))
  58
  59 (define (http-get-body uri)
  60   (call-with-values (lambda () (http-get uri))
  61     (lambda (response body) body)))
  62
  63 (define (http-get-port uri)
  64   (let ((socket (open-socket-for-uri uri)))
  65     ;; Make sure to use an unbuffered port so that we can then peek at the
  66     ;; underlying file descriptor via 'call-with-gzip-input-port'.
  67     (setvbuf socket 'none)
  68     (call-with-values
  69         (lambda ()
  70           (http-get uri #:port socket #:streaming? #t))
  71       (lambda (response port)
  72         ;; Don't (setvbuf port 'none) because of <http://bugs.gnu.org/19610>
  73         ;; (PORT might be a custom binary input port).
  74         port))))
  75
  76 (define (publish-uri route)
  77   (string-append "http://localhost:6789" route))
  78
  79 (define-syntax-rule (with-separate-output-ports exp ...)
  80   ;; Since ports aren't thread-safe in Guile 2.0, duplicate the output and
  81   ;; error ports to make sure the two threads don't end up stepping on each
  82   ;; other's toes.
  83   (with-output-to-port (duplicate-port (current-output-port) "w")
  84     (lambda ()
  85       (with-error-to-port (duplicate-port (current-error-port) "w")
  86         (lambda ()
  87           exp ...)))))
  88
  89 ;; Run a local publishing server in a separate thread.
  90 (with-separate-output-ports
  91  (call-with-new-thread
  92   (lambda ()
  93     (guix-publish "--port=6789" "-C0"))))     ;attempt to avoid port collision
  94
  95 (define (wait-until-ready port)
  96   ;; Wait until the server is accepting connections.
  97   (let ((conn (socket PF_INET SOCK_STREAM 0)))
  98     (let loop ()
  99       (unless (false-if-exception
 100                (connect conn AF_INET (inet-pton AF_INET "127.0.0.1") port))
 101         (loop)))))
 102
 103 (define (wait-for-file file)
 104   ;; Wait until FILE shows up.
 105   (let loop ((i 20))
 106     (cond ((file-exists? file)
 107            #t)
 108           ((zero? i)
 109            (error "file didn't show up" file))
 110           (else
 111            (pk 'wait-for-file file)
 112            (sleep 1)
 113            (loop (- i 1))))))
 114
 115 (define %gzip-magic-bytes
 116   ;; Magic bytes of gzip file.
 117   #vu8(#x1f #x8b))
 118
 119 ;; Wait until the two servers are ready.
 120 (wait-until-ready 6789)
 121
 122 ;; Initialize the public/private key SRFI-39 parameters.
 123 (%public-key (read-file-sexp %public-key-file))
 124 (%private-key (read-file-sexp %private-key-file))
 125
 126 \f
 127 (test-begin "publish")
 128
 129 (test-equal "/nix-cache-info"
 130   (format #f "StoreDir: ~a\nWantMassQuery: 0\nPriority: 100\n"
 131           %store-directory)
 132   (http-get-body (publish-uri "/nix-cache-info")))
 133
 134 (test-equal "/*.narinfo"
 135   (let* ((info (query-path-info %store %item))
 136          (unsigned-info
 137           (format #f
 138                   "StorePath: ~a
 139 URL: nar/~a
 140 Compression: none
 141 FileSize: ~a
 142 NarHash: sha256:~a
 143 NarSize: ~d
 144 References: ~a~%"
 145                   %item
 146                   (basename %item)
 147                   (path-info-nar-size info)
 148                   (bytevector->nix-base32-string
 149                    (path-info-hash info))
 150                   (path-info-nar-size info)
 151                   (basename (first (path-info-references info)))))
 152          (signature (base64-encode
 153                      (string->utf8
 154                       (canonical-sexp->string
 155                        ((@@ (guix scripts publish) signed-string)
 156                         unsigned-info))))))
 157     (format #f "~aSignature: 1;~a;~a~%"
 158             unsigned-info (gethostname) signature))
 159   (utf8->string
 160    (http-get-body
 161     (publish-uri
 162      (string-append "/" (store-path-hash-part %item) ".narinfo")))))
 163
 164 (test-equal "/*.narinfo with properly encoded '+' sign"
 165   ;; See <http://bugs.gnu.org/21888>.
 166   (let* ((item (add-text-to-store %store "fake-gtk+" "Congrats!"))
 167          (info (query-path-info %store item))
 168          (unsigned-info
 169           (format #f
 170                   "StorePath: ~a
 171 URL: nar/~a
 172 Compression: none
 173 FileSize: ~a
 174 NarHash: sha256:~a
 175 NarSize: ~d
 176 References: ~%"
 177                   item
 178                   (uri-encode (basename item))
 179                   (path-info-nar-size info)
 180                   (bytevector->nix-base32-string
 181                    (path-info-hash info))
 182                   (path-info-nar-size info)))
 183          (signature (base64-encode
 184                      (string->utf8
 185                       (canonical-sexp->string
 186                        ((@@ (guix scripts publish) signed-string)
 187                         unsigned-info))))))
 188     (format #f "~aSignature: 1;~a;~a~%"
 189             unsigned-info (gethostname) signature))
 190
 191   (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
 192     (utf8->string
 193      (http-get-body
 194       (publish-uri
 195        (string-append "/" (store-path-hash-part item) ".narinfo"))))))
 196
 197 (test-equal "/nar/*"
 198   "bar"
 199   (call-with-temporary-output-file
 200    (lambda (temp port)
 201      (let ((nar (utf8->string
 202                  (http-get-body
 203                   (publish-uri
 204                    (string-append "/nar/" (basename %item)))))))
 205        (call-with-input-string nar (cut restore-file <> temp)))
 206      (call-with-input-file temp read-string))))
 207
 208 (unless (zlib-available?)
 209   (test-skip 1))
 210 (test-equal "/nar/gzip/*"
 211   "bar"
 212   (call-with-temporary-output-file
 213    (lambda (temp port)
 214      (let ((nar (http-get-port
 215                  (publish-uri
 216                   (string-append "/nar/gzip/" (basename %item))))))
 217        (call-with-gzip-input-port nar
 218          (cut restore-file <> temp)))
 219      (call-with-input-file temp read-string))))
 220
 221 (unless (zlib-available?)
 222   (test-skip 1))
 223 (test-equal "/nar/gzip/* is really gzip"
 224   %gzip-magic-bytes
 225   ;; Since 'gzdopen' (aka. 'call-with-gzip-input-port') transparently reads
 226   ;; uncompressed gzip, the test above doesn't check whether it's actually
 227   ;; gzip.  This is what this test does.  See <https://bugs.gnu.org/30184>.
 228   (let ((nar (http-get-port
 229               (publish-uri
 230                (string-append "/nar/gzip/" (basename %item))))))
 231     (get-bytevector-n nar (bytevector-length %gzip-magic-bytes))))
 232
 233 (unless (lzlib-available?)
 234   (test-skip 1))
 235 (test-equal "/nar/lzip/*"
 236   "bar"
 237   (call-with-temporary-output-file
 238    (lambda (temp port)
 239      (let ((nar (http-get-port
 240                  (publish-uri
 241                   (string-append "/nar/lzip/" (basename %item))))))
 242        (call-with-lzip-input-port nar
 243          (cut restore-file <> temp)))
 244      (call-with-input-file temp read-string))))
 245
 246 (unless (zlib-available?)
 247   (test-skip 1))
 248 (test-equal "/*.narinfo with compression"
 249   `(("StorePath" . ,%item)
 250     ("URL" . ,(string-append "nar/gzip/" (basename %item)))
 251     ("Compression" . "gzip"))
 252   (let ((thread (with-separate-output-ports
 253                  (call-with-new-thread
 254                   (lambda ()
 255                     (guix-publish "--port=6799" "-C5"))))))
 256     (wait-until-ready 6799)
 257     (let* ((url  (string-append "http://localhost:6799/"
 258                                 (store-path-hash-part %item) ".narinfo"))
 259            (body (http-get-port url)))
 260       (filter (lambda (item)
 261                 (match item
 262                   (("Compression" . _) #t)
 263                   (("StorePath" . _)  #t)
 264                   (("URL" . _) #t)
 265                   (_ #f)))
 266               (recutils->alist body)))))
 267
 268 (unless (lzlib-available?)
 269   (test-skip 1))
 270 (test-equal "/*.narinfo with lzip compression"
 271   `(("StorePath" . ,%item)
 272     ("URL" . ,(string-append "nar/lzip/" (basename %item)))
 273     ("Compression" . "lzip"))
 274   (let ((thread (with-separate-output-ports
 275                  (call-with-new-thread
 276                   (lambda ()
 277                     (guix-publish "--port=6790" "-Clzip"))))))
 278     (wait-until-ready 6790)
 279     (let* ((url  (string-append "http://localhost:6790/"
 280                                 (store-path-hash-part %item) ".narinfo"))
 281            (body (http-get-port url)))
 282       (filter (lambda (item)
 283                 (match item
 284                   (("Compression" . _) #t)
 285                   (("StorePath" . _)  #t)
 286                   (("URL" . _) #t)
 287                   (_ #f)))
 288               (recutils->alist body)))))
 289
 290 (unless (zlib-available?)
 291   (test-skip 1))
 292 (test-equal "/*.narinfo for a compressed file"
 293   '("none" "nar")          ;compression-less nar
 294   ;; Assume 'guix publish -C' is already running on port 6799.
 295   (let* ((item (add-text-to-store %store "fake.tar.gz"
 296                                   "This is a fake compressed file."))
 297          (url  (string-append "http://localhost:6799/"
 298                               (store-path-hash-part item) ".narinfo"))
 299          (body (http-get-port url))
 300          (info (recutils->alist body)))
 301     (list (assoc-ref info "Compression")
 302           (dirname (assoc-ref info "URL")))))
 303
 304 (unless (and (zlib-available?) (lzlib-available?))
 305   (test-skip 1))
 306 (test-equal "/*.narinfo with lzip + gzip"
 307   `((("StorePath" . ,%item)
 308      ("URL" . ,(string-append "nar/gzip/" (basename %item)))
 309      ("Compression" . "gzip")
 310      ("URL" . ,(string-append "nar/lzip/" (basename %item)))
 311      ("Compression" . "lzip"))
 312     200
 313     200)
 314   (call-with-temporary-directory
 315    (lambda (cache)
 316      (let ((thread (with-separate-output-ports
 317                     (call-with-new-thread
 318                      (lambda ()
 319                        (guix-publish "--port=6793" "-Cgzip:2" "-Clzip:2"))))))
 320        (wait-until-ready 6793)
 321        (let* ((base "http://localhost:6793/")
 322               (part (store-path-hash-part %item))
 323               (url  (string-append base part ".narinfo"))
 324               (body (http-get-port url)))
 325          (list (take (recutils->alist body) 5)
 326                (response-code
 327                 (http-get (string-append base "nar/gzip/"
 328                                          (basename %item))))
 329                (response-code
 330                 (http-get (string-append base "nar/lzip/"
 331                                          (basename %item))))))))))
 332
 333 (test-equal "custom nar path"
 334   ;; Serve nars at /foo/bar/chbouib instead of /nar.
 335   (list `(("StorePath" . ,%item)
 336           ("URL" . ,(string-append "foo/bar/chbouib/" (basename %item)))
 337           ("Compression" . "none"))
 338         200
 339         404)
 340   (let ((thread (with-separate-output-ports
 341                  (call-with-new-thread
 342                   (lambda ()
 343                     (guix-publish "--port=6798" "-C0"
 344                                   "--nar-path=///foo/bar//chbouib/"))))))
 345     (wait-until-ready 6798)
 346     (let* ((base    "http://localhost:6798/")
 347            (part    (store-path-hash-part %item))
 348            (url     (string-append base part ".narinfo"))
 349            (nar-url (string-append base "foo/bar/chbouib/"
 350                                    (basename %item)))
 351            (body    (http-get-port url)))
 352       (list (filter (lambda (item)
 353                       (match item
 354                         (("Compression" . _) #t)
 355                         (("StorePath" . _)  #t)
 356                         (("URL" . _) #t)
 357                         (_ #f)))
 358                     (recutils->alist body))
 359             (response-code (http-get nar-url))
 360             (response-code
 361              (http-get (string-append base "nar/" (basename %item))))))))
 362
 363 (test-equal "/nar/ with properly encoded '+' sign"
 364   "Congrats!"
 365   (let ((item (add-text-to-store %store "fake-gtk+" "Congrats!")))
 366     (call-with-temporary-output-file
 367      (lambda (temp port)
 368        (let ((nar (utf8->string
 369                    (http-get-body
 370                     (publish-uri
 371                      (string-append "/nar/" (uri-encode (basename item))))))))
 372          (call-with-input-string nar (cut restore-file <> temp)))
 373        (call-with-input-file temp read-string)))))
 374
 375 (test-equal "/nar/invalid"
 376   404
 377   (begin
 378     (call-with-output-file (string-append (%store-prefix) "/invalid")
 379       (lambda (port)
 380         (display "This file is not a valid store item." port)))
 381     (response-code (http-get (publish-uri (string-append "/nar/invalid"))))))
 382
 383 (test-equal "/file/NAME/sha256/HASH"
 384   "Hello, Guix world!"
 385   (let* ((data "Hello, Guix world!")
 386          (hash (call-with-input-string data port-sha256))
 387          (drv  (run-with-store %store
 388                  (gexp->derivation "the-file.txt"
 389                                    #~(call-with-output-file #$output
 390                                        (lambda (port)
 391                                          (display #$data port)))
 392                                    #:hash-algo 'sha256
 393                                    #:hash hash)))
 394          (out  (build-derivations %store (list drv))))
 395     (utf8->string
 396      (http-get-body
 397       (publish-uri
 398        (string-append "/file/the-file.txt/sha256/"
 399                       (bytevector->nix-base32-string hash)))))))
 400
 401 (test-equal "/file/NAME/sha256/INVALID-NIX-BASE32-STRING"
 402   404
 403   (let ((uri (publish-uri
 404               "/file/the-file.txt/sha256/not-a-nix-base32-string")))
 405     (response-code (http-get uri))))
 406
 407 (test-equal "/file/NAME/sha256/INVALID-HASH"
 408   404
 409   (let ((uri (publish-uri
 410               (string-append "/file/the-file.txt/sha256/"
 411                              (bytevector->nix-base32-string
 412                               (call-with-input-string "" port-sha256))))))
 413     (response-code (http-get uri))))
 414
 415 (unless (zlib-available?)
 416   (test-skip 1))
 417 (test-equal "with cache"
 418   (list #t
 419         `(("StorePath" . ,%item)
 420           ("URL" . ,(string-append "nar/gzip/" (basename %item)))
 421           ("Compression" . "gzip"))
 422         200                                       ;nar/gzip/…
 423         #t                                        ;Content-Length
 424         #t                                        ;FileSize
 425         404)                                      ;nar/…
 426   (call-with-temporary-directory
 427    (lambda (cache)
 428      (let ((thread (with-separate-output-ports
 429                     (call-with-new-thread
 430                      (lambda ()
 431                        (guix-publish "--port=6797" "-C2"
 432                                      (string-append "--cache=" cache)))))))
 433        (wait-until-ready 6797)
 434        (let* ((base     "http://localhost:6797/")
 435               (part     (store-path-hash-part %item))
 436               (url      (string-append base part ".narinfo"))
 437               (nar-url  (string-append base "nar/gzip/" (basename %item)))
 438               (cached   (string-append cache "/gzip/" (basename %item)
 439                                        ".narinfo"))
 440               (nar      (string-append cache "/gzip/"
 441                                        (basename %item) ".nar"))
 442               (response (http-get url)))
 443          (and (= 404 (response-code response))
 444
 445               ;; We should get an explicitly short TTL for 404 in this case
 446               ;; because it's going to become 200 shortly.
 447               (match (assq-ref (response-headers response) 'cache-control)
 448                 ((('max-age . ttl))
 449                  (< ttl 3600)))
 450
 451               (wait-for-file cached)
 452               (let* ((body         (http-get-port url))
 453                      (compressed   (http-get nar-url))
 454                      (uncompressed (http-get (string-append base "nar/"
 455                                                             (basename %item))))
 456                      (narinfo      (recutils->alist body)))
 457                 (list (file-exists? nar)
 458                       (filter (lambda (item)
 459                                 (match item
 460                                   (("Compression" . _) #t)
 461                                   (("StorePath" . _)  #t)
 462                                   (("URL" . _) #t)
 463                                   (_ #f)))
 464                               narinfo)
 465                       (response-code compressed)
 466                       (= (response-content-length compressed)
 467                          (stat:size (stat nar)))
 468                       (= (string->number
 469                           (assoc-ref narinfo "FileSize"))
 470                          (stat:size (stat nar)))
 471                       (response-code uncompressed)))))))))
 472
 473 (unless (and (zlib-available?) (lzlib-available?))
 474   (test-skip 1))
 475 (test-equal "with cache, lzip + gzip"
 476   '(200 200 404)
 477   (call-with-temporary-directory
 478    (lambda (cache)
 479      (let ((thread (with-separate-output-ports
 480                     (call-with-new-thread
 481                      (lambda ()
 482                        (guix-publish "--port=6794" "-Cgzip:2" "-Clzip:2"
 483                                      (string-append "--cache=" cache)))))))
 484        (wait-until-ready 6794)
 485        (let* ((base     "http://localhost:6794/")
 486               (part     (store-path-hash-part %item))
 487               (url      (string-append base part ".narinfo"))
 488               (nar-url  (cute string-append "nar/" <> "/"
 489                               (basename %item)))
 490               (cached   (cute string-append cache "/" <> "/"
 491                               (basename %item) ".narinfo"))
 492               (nar      (cute string-append cache "/" <> "/"
 493                               (basename %item) ".nar"))
 494               (response (http-get url)))
 495          (wait-for-file (cached "gzip"))
 496          (let* ((body         (http-get-port url))
 497                 (narinfo      (recutils->alist body))
 498                 (uncompressed (string-append base "nar/"
 499                                              (basename %item))))
 500            (and (file-exists? (nar "gzip"))
 501                 (file-exists? (nar "lzip"))
 502                 (equal? (take (pk 'narinfo/gzip+lzip narinfo) 7)
 503                         `(("StorePath" . ,%item)
 504                           ("URL" . ,(nar-url "gzip"))
 505                           ("Compression" . "gzip")
 506                           ("FileSize" . ,(number->string
 507                                           (stat:size (stat (nar "gzip")))))
 508                           ("URL" . ,(nar-url "lzip"))
 509                           ("Compression" . "lzip")
 510                           ("FileSize" . ,(number->string
 511                                           (stat:size (stat (nar "lzip")))))))
 512                 (list (response-code
 513                        (http-get (string-append base (nar-url "gzip"))))
 514                       (response-code
 515                        (http-get (string-append base (nar-url "lzip"))))
 516                       (response-code
 517                        (http-get uncompressed))))))))))
 518
 519 (unless (zlib-available?)
 520   (test-skip 1))
 521 (let ((item (add-text-to-store %store "fake-compressed-thing.tar.gz"
 522                                (random-text))))
 523   (test-equal "with cache, uncompressed"
 524     (list #t
 525           (* 42 3600)                             ;TTL on narinfo
 526           `(("StorePath" . ,item)
 527             ("URL" . ,(string-append "nar/" (basename item)))
 528             ("Compression" . "none"))
 529           200                                     ;nar/…
 530           (* 42 3600)                             ;TTL on nar/…
 531           (path-info-nar-size
 532            (query-path-info %store item))         ;FileSize
 533           404)                                    ;nar/gzip/…
 534     (call-with-temporary-directory
 535      (lambda (cache)
 536        (let ((thread (with-separate-output-ports
 537                       (call-with-new-thread
 538                        (lambda ()
 539                          (guix-publish "--port=6796" "-C2" "--ttl=42h"
 540                                        (string-append "--cache=" cache)))))))
 541          (wait-until-ready 6796)
 542          (let* ((base     "http://localhost:6796/")
 543                 (part     (store-path-hash-part item))
 544                 (url      (string-append base part ".narinfo"))
 545                 (cached   (string-append cache "/none/"
 546                                          (basename item) ".narinfo"))
 547                 (nar      (string-append cache "/none/"
 548                                          (basename item) ".nar"))
 549                 (response (http-get url)))
 550            (and (= 404 (response-code response))
 551
 552                 (wait-for-file cached)
 553                 (let* ((response     (http-get url))
 554                        (body         (http-get-port url))
 555                        (compressed   (http-get (string-append base "nar/gzip/"
 556                                                               (basename item))))
 557                        (uncompressed (http-get (string-append base "nar/"
 558                                                               (basename item))))
 559                        (narinfo      (recutils->alist body)))
 560                   (list (file-exists? nar)
 561                         (match (assq-ref (response-headers response)
 562                                          'cache-control)
 563                           ((('max-age . ttl)) ttl)
 564                           (_ #f))
 565
 566                         (filter (lambda (item)
 567                                   (match item
 568                                     (("Compression" . _) #t)
 569                                     (("StorePath" . _)  #t)
 570                                     (("URL" . _) #t)
 571                                     (_ #f)))
 572                                 narinfo)
 573                         (response-code uncompressed)
 574                         (match (assq-ref (response-headers uncompressed)
 575                                          'cache-control)
 576                           ((('max-age . ttl)) ttl)
 577                           (_ #f))
 578
 579                         (string->number
 580                          (assoc-ref narinfo "FileSize"))
 581                         (response-code compressed))))))))))
 582
 583 (test-equal "with cache, vanishing item"         ;<https://bugs.gnu.org/33897>
 584   200
 585   (call-with-temporary-directory
 586    (lambda (cache)
 587      (let ((thread (with-separate-output-ports
 588                     (call-with-new-thread
 589                      (lambda ()
 590                        (guix-publish "--port=6795"
 591                                      (string-append "--cache=" cache)))))))
 592        (wait-until-ready 6795)
 593
 594        ;; Make sure that, even if ITEM disappears, we're still able to fetch
 595        ;; it.
 596        (let* ((base     "http://localhost:6795/")
 597               (item     (add-text-to-store %store "random" (random-text)))
 598               (part     (store-path-hash-part item))
 599               (url      (string-append base part ".narinfo"))
 600               (cached   (string-append cache
 601                                        (if (zlib-available?)
 602                                            "/gzip/" "/none/")
 603                                        (basename item)
 604                                        ".narinfo"))
 605               (response (http-get url)))
 606          (and (= 404 (response-code response))
 607               (wait-for-file cached)
 608               (begin
 609                 (delete-paths %store (list item))
 610                 (response-code (pk 'response (http-get url))))))))))
 611
 612 (test-equal "/log/NAME"
 613   `(200 #t application/x-bzip2)
 614   (let ((drv (run-with-store %store
 615                (gexp->derivation "with-log"
 616                                  #~(call-with-output-file #$output
 617                                      (lambda (port)
 618                                        (display "Hello, build log!"
 619                                                 (current-error-port))
 620                                        (display #$(random-text) port)))))))
 621     (build-derivations %store (list drv))
 622     (let* ((response (http-get
 623                       (publish-uri (string-append "/log/"
 624                                                   (basename (derivation->output-path drv))))
 625                       #:decode-body? #f))
 626            (base     (basename (derivation-file-name drv)))
 627            (log      (string-append (dirname %state-directory)
 628                                     "/log/guix/drvs/" (string-take base 2)
 629                                     "/" (string-drop base 2) ".bz2")))
 630       (list (response-code response)
 631             (= (response-content-length response) (stat:size (stat log)))
 632             (first (response-content-type response))))))
 633
 634 (test-equal "/log/NAME not found"
 635   404
 636   (let ((uri (publish-uri "/log/does-not-exist")))
 637     (response-code (http-get uri))))
 638
 639 (test-equal "non-GET query"
 640   '(200 404)
 641   (let ((path (string-append "/" (store-path-hash-part %item)
 642                              ".narinfo")))
 643     (map response-code
 644          (list (http-get (publish-uri path))
 645                (http-post (publish-uri path))))))
 646
 647 (test-end "publish")