[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Chicken-hackers] [PATCH] handle "local" transport properly when downloa
From: |
Felix |
Subject: |
[Chicken-hackers] [PATCH] handle "local" transport properly when downloading eggs |
Date: |
Fri, 26 Apr 2013 12:01:25 +0200 (CEST) |
When trying all available sources for egg-download, do not invalidate
list-entries on failure for "local" transport. This allows using
local egg-trees as "overlay" repositories. Hetwork-based transports
are still invalidated once a download failed, as it is assumed that
the network access is down (or timing out). This patch also fixes a
bug in the handling of "local" transport, which didn't test whether
the egg directory actually existed.
cheers
felix
>From e3e9eb2588476682eb00ee0bd449727b9a1ad3d3 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Fri, 26 Apr 2013 11:56:42 +0200
Subject: [PATCH] when trying all available sources for egg-download, do not
invalidate list-entries on failure for "local" transport.
This allows using local egg-trees as "overlay"
repositories. Hetwork-based transports are still
invalidated once a download failed, as it is assumed that
the network access is down (or timing out). This patch also
fixes a bug in the handling of "local" transport, which
didn't test whether the egg directory acutally existed.
---
chicken-install.scm | 45 +++++++++++++++++++++++----------------------
setup-download.scm | 4 +++-
2 files changed, 26 insertions(+), 23 deletions(-)
diff --git a/chicken-install.scm b/chicken-install.scm
index 1ba5b97..4283d03 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -196,9 +196,6 @@
(transport ,*default-transport*)))
*default-sources* ) )
- (define (invalidate-default-source! def)
- (set! *default-sources* (delete def *default-sources* eq?)) )
-
(define (deps key meta)
(or (and-let* ((d (assq key meta)))
(cdr d))
@@ -337,26 +334,30 @@
(abort e) ] ) )
(define (with-default-sources proc)
- (let trying-sources ([defs (known-default-sources)])
- (if (null? defs)
- (proc #f #f
- (lambda ()
- (with-output-to-port (current-error-port)
- (lambda ()
- (print "Could not determine a source of extensions. "
- "Please, specify a location and a transport for "
- "a source.")))
- (exit 1)))
- (let* ([def (car defs)]
- [locn (resolve-location
- (cadr (or (assq 'location def)
- (error "missing location entry" def))))]
- [trans (cadr (or (assq 'transport def)
- (error "missing transport entry" def)))])
- (proc trans locn
+ (let ((sources (known-default-sources)))
+ (let trying-sources ((defs sources))
+ (if (null? defs)
+ (proc #f #f
(lambda ()
- (invalidate-default-source! def)
- (trying-sources (cdr defs)) ) ) ) ) ) )
+ (with-output-to-port (current-error-port)
+ (lambda ()
+ (print "Could not determine a source of extensions. "
+ "Please specify a valid location and
transport.")))
+ (exit 1)))
+ (let ((def (car defs)))
+ (if def
+ (let* ((locn (resolve-location
+ (cadr (or (assq 'location def)
+ (error "missing location entry"
def)))))
+ (trans (cadr (or (assq 'transport def)
+ (error "missing transport entry"
def)))))
+ (proc trans locn
+ (lambda ()
+ (unless (eq? 'local trans)
+ ;; invalidate this entry in the list of sources
+ (set-car! defs #f))
+ (trying-sources (cdr defs)))))
+ (trying-sources (cdr defs))))))))
(define (try-default-sources name version)
(with-default-sources
diff --git a/setup-download.scm b/setup-download.scm
index 30934c4..06c040b 100644
--- a/setup-download.scm
+++ b/setup-download.scm
@@ -106,7 +106,9 @@
(if (and (file-exists? trunkdir) (directory?
trunkdir))
(values trunkdir "trunk")
(values eggdir "") ) ) ) ) )
- (cond (dest
+ (cond ((or (not (file-exists? eggdir)) (not (directory? eggdir)))
+ (values #f ""))
+ (dest
(create-directory dest)
(let ((qdest (qs (normalize-pathname dest)))
(qsrc (qs (normalize-pathname src)))
--
1.7.9.5
- [Chicken-hackers] [PATCH] handle "local" transport properly when downloading eggs,
Felix <=