From b2cee7bed9d003199ca61774c8f63be7a2f1b7eb Mon Sep 17 00:00:00 2001 From: Jacob Matthews Date: Fri, 4 Aug 2006 15:37:12 +0000 Subject: [PATCH] Added preliminary support for installation policy configuration svn: r3958 --- collects/planet/resolver.ss | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/collects/planet/resolver.ss b/collects/planet/resolver.ss index ca27424ecb..1bbfc245b8 100644 --- a/collects/planet/resolver.ss +++ b/collects/planet/resolver.ss @@ -167,7 +167,8 @@ an appropriate subdirectory. pkg->download-url pkg-promise->pkg install-pkg - get-planet-module-path/pkg) + get-planet-module-path/pkg + install?) (define install? (make-parameter #t)) ;; if #f, will not install packages and instead give an error @@ -496,6 +497,14 @@ attempted to load version ~a.~a while version ~a.~a was already loaded" ; install-pkg : FULL-PKG-SPEC path[file] Nat Nat -> PKG ; install the given pkg to the planet cache and return a PKG representing the installed file (define (install-pkg pkg path maj min) + (unless (install?) + (raise (make-exn:fail + (string->immutable-string + (format + "PLaneT error: cannot install package ~s since the install? parameter is set to #f" + (list (car (pkg-spec-path pkg)) (pkg-spec-name pkg) maj min))) + (current-continuation-marks)))) + (let* ((owner (car (pkg-spec-path pkg))) (extra-path (cdr (pkg-spec-path pkg))) (the-dir