>From 9e908ee6da0a4c123a3af38e4dc921c66b85e522 Mon Sep 17 00:00:00 2001
From: Evan Hanson <address@hidden>
Date: Wed, 25 Jul 2018 21:18:48 +1200
Subject: [PATCH 4/4] Two small fixes for egg refetching behaviour

When a specific egg version is requested and does not match what's
already in the cache, refetch it. Previously, the version in the cache
might have been used, despite the version difference. When the user
hasn't specified a version, the behaviour remains the same.

Fix the version comparison logic in `check-remote-version' so that an
egg is only fetched when a remote version is newer than the one in the
cache. Previously, this procedure was checking whether any remote
version is newer than the *requested* one (which might also be #f), but
it should actually indicate the opposite, i.e. it should return #t if
*no* remote version is newer than the local one (which should be the
cached version, not the requested version).
---
 chicken-install.scm | 24 +++++++++---------------
 1 file changed, 9 insertions(+), 15 deletions(-)

diff --git a/chicken-install.scm b/chicken-install.scm
index d382aed3..e0967cd4 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -395,7 +395,6 @@
 (define (locate-egg name version)
   (let* ((cached (make-pathname cache-directory name))
          (now (current-seconds))
-         (timestamp (make-pathname cached +timestamp-file+))
          (status (make-pathname cached +status-file+))
          (eggfile (make-pathname cached name +egg-extension+)))
     (define (fetch lax)
@@ -420,22 +419,17 @@
                  (else (fetch #f)))))
     (let* ((info (validate-egg-info (load-egg-info eggfile)))
            (vfile (make-pathname cached +version-file+))
+           (tfile (make-pathname cached +timestamp-file+))
            (lversion (or (get-egg-property info 'version)
                          (and (file-exists? vfile)
                               (with-input-from-file vfile read)))))
       (cond ((and (not cached-only)
-                  (if (file-exists? timestamp)
-                      (and (> (- now (with-input-from-file
-                                       timestamp read))
-                              +one-hour+)
-                           (not (check-remote-version name
-                                                      version
-                                                      lversion
-                                                      cached)))
-                      (not (check-remote-version name
-                                                 version
-                                                 lversion
-                                                 cached))))
+                  (or (and (string? version)
+                           (not (equal? version lversion)))
+                      (and (or (not (file-exists? tfile))
+                               (> (- now (with-input-from-file tfile read))
+                                  +one-hour+))
+                           (not (check-remote-version name lversion cached)))))
              (d "version of ~a out of date~%" name)
              (fetch #t)
              (let* ((info (validate-egg-info (load-egg-info eggfile))) ; new egg info (fetched)
@@ -507,14 +501,14 @@
     (d "~a~%" cmd)
     (system cmd)))
   
-(define (check-remote-version name version lversion cached)
+(define (check-remote-version name lversion cached)
   (let loop ((locs default-locations))
     (cond ((null? locs)
            (let loop ((srvs (map resolve-location default-servers)))
              (and (pair? srvs)
                   (let ((versions (try-list-versions name (car srvs))))
                     (or (and versions
-                             (any (cut version>=? <> version) versions))
+                             (every (cut version>=? lversion <>) versions))
                         (loop (cdr srvs)))))))
           ((probe-dir (make-pathname (car locs) name)) =>
            (lambda (dir)
-- 
2.11.0