1 files changed, 25 insertions, 11 deletions
diff --git a/guix/gnu-maintenance.scm b/guix/gnu-maintenance.scm
index 7c7ca65d7b..796c2d6569 100644
--- a/guix/gnu-maintenance.scm
+++ b/guix/gnu-maintenance.scm
@@ -454,7 +454,9 @@ hosted on ftp.gnu.org, or not under that name (this is the case for
     (define (string->lines str)
       (string-tokenize str (char-set-complement (char-set #\newline))))
 
-    (let ((port (http-fetch/cached %gnu-file-list-uri #:ttl (* 60 60))))
+    ;; Since https://ftp.gnu.org honors 'If-Modified-Since', the hard-coded
+    ;; TTL can be relatively short.
+    (let ((port (http-fetch/cached %gnu-file-list-uri #:ttl (* 15 60))))
       (map trim-leading-components
            (call-with-gzip-input-port port
              (compose string->lines get-string-all))))))
@@ -471,18 +473,30 @@ list available from %GNU-FILE-LIST-URI over HTTP(S)."
                 (package-upstream-name package)))
     (let* ((files    (ftp.gnu.org-files))
            (relevant (filter (lambda (file)
-                               (and (string-contains file directory)
-                                    (release-file? name (basename file))
-                                    ))
+                               (and (string-prefix? "/gnu" file)
+                                    (string-contains file directory)
+                                    (release-file? name (basename file))))
                              files)))
       (match (sort relevant (lambda (file1 file2)
-                              (version>? (basename file1) (basename file2))))
-        ((tarball _ ...)
-         (upstream-source
-          (package name)
-          (version (tarball->version tarball))
-          (urls (list (string-append "mirror://gnu/" tarball)))
-          (signature-urls (map (cut string-append <> ".sig") urls))))
+                              (version>? (sans-extension (basename file1))
+                                         (sans-extension (basename file2)))))
+        ((and tarballs (reference _ ...))
+         (let* ((version  (tarball->version reference))
+                (tarballs (filter (lambda (file)
+                                    (string=? (sans-extension
+                                               (basename file))
+                                              (sans-extension
+                                               (basename reference))))
+                                  tarballs)))
+           (upstream-source
+            (package name)
+            (version version)
+            (urls (map (lambda (file)
+                         (string-append "mirror://gnu/"
+                                        (string-drop file
+                                                     (string-length "/gnu/"))))
+                       tarballs))
+            (signature-urls (map (cut string-append <> ".sig") urls)))))
         (()
          #f)))))