;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015, 2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 (test-cpio)
  #:use-module (guix cpio)
  #:use-module (guix tests)
  #:use-module ((guix build utils)
                #:select (which call-with-temporary-output-file))
  #:use-module (ice-9 match)
  #:use-module (ice-9 popen)
  #:use-module (rnrs io ports)
  #:use-module (srfi srfi-1)
  #:use-module (srfi srfi-26)
  #:use-module (srfi srfi-64))

(define %cpio-program
  (which "cpio"))

(define %test-file
  (search-path %load-path "guix.scm"))


(test-begin "cpio")

;; The cpio format expects 'ino' to fit in 32 bits.  If we have a bigger inode
;; number, skip this test.
(test-skip
 (if (>= (stat:ino (lstat %test-file)) (expt 2 32)) 1 0))
(test-assert "file->cpio-header + write-cpio-header + read-cpio-header"
  (let* ((header (file->cpio-header %test-file)))
    (call-with-values
        (lambda ()
          (open-bytevector-output-port))
      (lambda (port get-bv)
        (write-cpio-header header port)
        (let ((port (open-bytevector-input-port (get-bv))))
          (equal? header (read-cpio-header port)))))))

(unless %cpio-program (test-skip 1))
(test-assert "bit-identical to GNU cpio's output"
  (call-with-temporary-output-file
   (lambda (link _)
     (delete-file link)
     (symlink "chbouib" link)

     (let ((files (cons* "/"
                         (canonicalize-path
                          (dirname (search-path %load-path "guix.scm")))
                         link
                         (map (compose canonicalize-path
                                       (cut search-path %load-path <>))
                              '("guix.scm" "guix/build/syscalls.scm"
                                "guix/packages.scm")))))
       (call-with-temporary-output-file
        (lambda (ref-file _)
          (let ((pipe (open-pipe* OPEN_WRITE %cpio-program "-o" "-O" ref-file
                                  "-H" "newc" "--null")))
            (for-each (lambda (file)
                        (format pipe "~a\0" file))
                      files)
            (and (zero? (close-pipe pipe))
                 (call-with-temporary-output-file
                  (lambda (file port)
                    (write-cpio-archive files port)
                    (close-port port)
                    (or (file=? ref-file file)
                        (throw 'cpio-archives-differ files
                               ref-file file
                               (stat:size (stat ref-file))
                               (stat:size (stat file))))))))))))))

(test-end "cpio")
3-06-08</span></td><td><a href='/guix/commit/tests/substitute.scm?id=885d524f79aa4bbfac5dfebf285e1e248184ee70'>substitute: Gracefully retry after failed partial downloads.</a><span class='msg-avail'>...<span class='msg-tooltip'>Fixes &lt;https://issues.guix.gnu.org/63443&gt;.
Reported by Attila Lendvai &lt;attila@lendvai.name&gt;.

* guix/scripts/substitute.scm (catch-system-error): New macro.
(download-nar): Add call to 'delete-file-recursively'.
* tests/substitute.scm ("substitute, previous partial download around"):
New test.
</span></span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2023-05-30 00:15:29 +0200'>2023-05-30</span></td><td><a href='/guix/commit/tests/substitute.scm?id=8af9a2aa5fa2fa5b00234c1cbe12e9aff60888a0'>substitute: If a server's nar URL is 404, try the next one(s).</a><span class='msg-avail'>...<span class='msg-tooltip'>If a substitute server advertises in its narinfo, for example, both a
/zstd and a /lzip URL but the /zstd URL is unreachable, try the /lzip
URL.

Fixes &lt;https://issues.guix.gnu.org/63634&gt;.

* guix/narinfo.scm (narinfo-preferred-uris): New procedure.
(narinfo-best-uri): Rebase on top of it.
* guix/scripts/substitute.scm (download-nar)[try-fetch]: New procedure.
Use 'narinfo-preferred-uris' and 'try-fetch' to attempt all the URLs of
NARINFO.
* tests/substitute.scm (request-substitution): Remove 'parameterize'.
Delete DESTINATION.
("substitute, preferred nar URL is 404, other is 200"): New test.
</span></span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2022-09-28 22:28:27 +0200'>2022-09-28</span></td><td><a href='/guix/commit/tests/substitute.scm?id=8bd4126917f59f4af9a4323c3d5699201862dca2'>substitute: Retry downloading when a nar is unavailable.</a><span class='msg-avail'>...<span class='msg-tooltip'>Fixes &lt;https://issues.guix.gnu.org/57978&gt;
Reported by Attila Lendvai &lt;attila@lendvai.name&gt;.

Previously, if a narinfo was available but its corresponding nar was
missing (for instance because the narinfo was cached and the server
became unreachable in the meantime), 'guix substitute --substitute'
would try to download the nar from its preferred location and abort when
that fails.  This change forces one retry with each of the URLs.

* guix/scripts/substitute.scm (download-nar): Do not catch
'http-get-error?' exceptions.
(system-error?, network-error?, process-substitution/fallback): New
procedures.
(process-substitution): Call 'process-substitution/fallback' upon
'network-error?'.
* tests/substitute.scm ("substitute, first URL has narinfo but lacks nar, second URL unauthorized")
("substitute, first URL has narinfo but nar is 404, both URLs authorized")
("substitute, first URL has narinfo but nar is 404, one URL authorized")
("substitute, narinfo is available but nar is missing"): New tests.
</span></span></td><td>Ludovic Courtès</td></tr>
<tr><td><span title='2022-09-24 17:59:04 +0200'>2022-09-24</span></td><td><a href='/guix/commit/tests/substitute.scm?id=08023bcab35faafcf3e9c77babe910d9ece240d2'>substitute: Test behavior with unroutable substitute server addresses.</a><span class='msg-avail'>...<span class='msg-tooltip'>* tests/substitute.scm (%unroutable-substitute-url): New variable.
("query narinfo signed with authorized key, unroutable URL first")
("substitute, authorized key, first substitute URL is unroutable"): New
tests.
</span></span></td><td>Ludovic Courtès</td></tr>