diff --git a/collects/planet/cachepath.ss b/collects/planet/cachepath.ss new file mode 100644 index 0000000000..46739853c4 --- /dev/null +++ b/collects/planet/cachepath.ss @@ -0,0 +1,11 @@ +(module cachepath mzscheme + + (require "config.ss") + (provide get-planet-cache-path) + + ;; get-planet-cache-path : -> path[absolute, file] + ;; the path to the cache.ss file for the planet installation + ;; SIDE EFFECT: creates the directory if it doesn't already exist + (define (get-planet-cache-path) + (let ((path (build-path (PLANET-DIR) "cache.ss"))) + path))) \ No newline at end of file diff --git a/collects/planet/planet-archives.ss b/collects/planet/planet-archives.ss index 5f21a9c608..c8a4d103fd 100644 --- a/collects/planet/planet-archives.ss +++ b/collects/planet/planet-archives.ss @@ -1,7 +1,8 @@ (module planet-archives mzscheme (require "private/planet-shared.ss" (lib "file.ss") - "config.ss") + "config.ss" + "cachepath.ss") (provide repository-tree get-installed-planet-archives get-planet-cache-path) @@ -30,11 +31,4 @@ min))) x)) (repository-tree) - 3))) - - ;; get-planet-cache-path : -> path[absolute, file] - ;; the path to the cache.ss file for the planet installation - ;; SIDE EFFECT: creates the directory if it doesn't already exist - (define (get-planet-cache-path) - (let ((path (build-path (PLANET-DIR) "cache.ss"))) - path))) + 3)))) diff --git a/collects/planet/private/planet-shared.ss b/collects/planet/private/planet-shared.ss index 81921ea886..41c3b86b9e 100644 --- a/collects/planet/private/planet-shared.ss +++ b/collects/planet/private/planet-shared.ss @@ -10,6 +10,7 @@ Various common pieces of code that both the client and server need to access (lib "etc.ss") (lib "port.ss") (lib "file.ss") + (lib "getinfo.ss" "setup") "../config.ss") (provide (all-defined)) @@ -56,6 +57,17 @@ Various common pieces of code that both the client and server need to access ;; assoc-table ::= (listof (list n n path)) (define empty-table '()) + ;; get-min-core-version : path -> string | #f + (define (get-min-core-version p) + (let ((info (with-handlers ([exn:fail? (lambda (e) #f)]) + (get-info/full p)))) + (if info + (let ((core (info 'required-core-version (lambda () #f)))) + (if (and core (string? core)) + core + #f)) + #f))) + ; dir->assoc-table : FULL-PKG-SPEC -> assoc-table ; returns the on-disk packages for the given planet dir (define (dir->assoc-table pkg) @@ -65,18 +77,14 @@ Various common pieces of code that both the client and server need to access (let ((maj (string->number majs)) (min (string->number mins))) (if (and (path? p) maj min) - (let* ((the-path (build-path path majs mins)) - (minimum-core-version - (if (file-exists? (build-path the-path "minimum-core-version")) - (with-input-from-file (build-path the-path "minimum-core-version") - read-line) - #f))) + (let* ((the-path (build-path path majs mins)) + (min-core-version (get-min-core-version the-path))) (make-assoc-table-row (pkg-spec-name pkg) (pkg-spec-path pkg) maj min the-path - minimum-core-version)) + min-core-version)) #f))) (if (directory-exists? path) @@ -195,7 +203,7 @@ Various common pieces of code that both the client and server need to access (define (string->mz-version str) (let ((ver (regexp-match #rx"^([0-9]+)(\\.([0-9]+))?$" str))) (if ver - (make-mz-version (list-ref ver 1) (list-ref ver 3)) + (make-mz-version (string->number (list-ref ver 1)) (string->number (list-ref ver 3))) #f))) ;; version<= : mz-version mz-version -> boolean