From b4b965180ef5ae337380ab7a93fcf41c8cf1acd2 Mon Sep 17 00:00:00 2001 From: Jacob Matthews Date: Sat, 21 Jan 2006 19:01:36 +0000 Subject: [PATCH] Bugfix for package crashing bug svn: r1914 --- collects/planet/private/planet-shared.ss | 16 ++++++++-------- collects/planet/util.ss | 5 ++++- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/collects/planet/private/planet-shared.ss b/collects/planet/private/planet-shared.ss index 9a76c9d2d8..440dd61786 100644 --- a/collects/planet/private/planet-shared.ss +++ b/collects/planet/private/planet-shared.ss @@ -49,23 +49,23 @@ Various common pieces of code that both the client and server need to access ; build-assoc-table : FULL-PKG-SPEC -> assoc-table ; returns a version-number -> directory association table for the given package (define (build-assoc-table pkg) - (let ((path (build-path (apply build-path (CACHE-DIR) (pkg-spec-path pkg)) (pkg-spec-name pkg)))) - (add-to-table - (dir->assoc-table path) - (hard-links pkg)))) + (add-to-table + (dir->assoc-table pkg) + (hard-links pkg))) ;; assoc-table ::= (listof (list n n path)) (define empty-table '()) - ; dir->assoc-table : path -> assoc-table - ; returns the association table for the given planet dir - (define (dir->assoc-table path) + ; dir->assoc-table : FULL-PKG-SPEC -> assoc-table + ; returns the on-disk packages for the given planet dir + (define (dir->assoc-table pkg) + (define path (build-path (apply build-path (CACHE-DIR) (pkg-spec-path pkg)) (pkg-spec-name pkg))) (define (tree-stuff->row-or-false p majs mins) (let ((maj (string->number majs)) (min (string->number mins))) (if (and (path? p) maj min) - (list maj min (build-path path majs mins)) + (list (pkg-spec-name pkg) (pkg-spec-path pkg) maj min (build-path path majs mins)) #f))) (if (directory-exists? path) diff --git a/collects/planet/util.ss b/collects/planet/util.ss index 01932f86fd..91e2d0eb84 100644 --- a/collects/planet/util.ss +++ b/collects/planet/util.ss @@ -120,7 +120,10 @@ ;; gives the current "linkage table"; a table that links modules to particular versions ;; of planet requires that satisfy those linkages (define (current-linkage) - (let* ((links (with-input-from-file (LINKAGE-FILE) read-all)) + (let* ((links + (if (file-exists? (LINKAGE-FILE)) + (with-input-from-file (LINKAGE-FILE) read-all) + '())) (buckets (categorize caar links))) (map (lambda (x) (cons (car x) (map (lambda (y) (drop-last (cadr y))) (cdr x))))