branch master updated: website: packages: Correctly deal with unusual origin patches.

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script.

civodul pushed a commit to branch master
in repository guix-artwork.

The following commit(s) were added to refs/heads/master by this push:
     new df39e9c  website: packages: Correctly deal with unusual origin patches.
df39e9c is described below

commit df39e9c20529571f137773c68be086a1f19755ef
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Jul 20 17:31:30 2022 +0200

    website: packages: Correctly deal with unusual origin patches.
    
    Fixes a crash when a patch is an "unusual" file-like object, as is the
    case with the <file-append> patches added in Guix commit
    87a10e315f60a198875dec31665b6a8775c9ca9c.
    
    * website/apps/packages/utils.scm (package-patches)[patch-url]: Return #f
    if the argument is unrecognized.
    [patches]: Check whether 'patch-url' returns #f.  Use 'filter-map'
    instead of 'map'.
---
 website/apps/packages/utils.scm | 21 +++++++++++++--------
 1 file changed, 13 insertions(+), 8 deletions(-)

diff --git a/website/apps/packages/utils.scm b/website/apps/packages/utils.scm
index aca6ae6..50e56b0 100644
--- a/website/apps/packages/utils.scm
+++ b/website/apps/packages/utils.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix web site
-;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Eric Bavier <bavier@member.fsf.org>
 ;;; Copyright © 2020 Ricardo Wurmus <rekado@elephly.net>
 ;;;
@@ -196,7 +196,10 @@ vocabulary."
                                       (match (origin-uri patch)
                                         ((? string? uri) uri)
                                         ((head . tail) head)))
-                                     %mirrors))))))
+                                     %mirrors))))
+      (_
+       ;; It might be a <file-append> or some other file-like object.
+       #f)))
 
   (define patch-name
     (match-lambda
@@ -218,12 +221,14 @@ vocabulary."
       (ilink "snippet" (ilink-url link))))
 
   (define patches
-    (map (lambda (patch)
-           (ilink `(span (@ (class "mono")) ,(patch-name patch))
-                 (patch-url patch)))
-         (match (package-source package)
-           (#f '())
-           ((? origin? o) (origin-patches o)))))
+    (filter-map (lambda (patch)
+                  (let ((url (patch-url patch)))
+                    (and url
+                         (ilink `(span (@ (class "mono")) ,(patch-name patch))
+                               (patch-url patch)))))
+                (match (package-source package)
+                  (#f '())
+                  ((? origin? o) (origin-patches o)))))
 
   (define snippet
     (match (package-source package)