Explicitly enabling download? and install? on user initiated installs

Forgot to commit earlier :(
This commit is contained in:
Jay McCarthy 2013-11-27 18:41:16 -07:00
parent 60ae164d05
commit c980182b6b
2 changed files with 21 additions and 17 deletions

View File

@ -12,6 +12,7 @@ PLANNED FEATURES:
racket/match
raco/command-name
(only-in planet/resolver download?)
planet/config
planet/private/planet-shared
planet/util
@ -160,17 +161,18 @@ This command does not unpack or install the named .plt file."
(fail "Could not find matching package")))))
(define (download/no-install owner pkg majstr minstr)
(let* ([maj (read-from-string majstr)]
[min (read-from-string minstr)]
[full-pkg-spec (get-package-spec owner pkg maj min)])
(when (file-exists? pkg)
(fail "Cannot download, there is a file named ~a in the way" pkg))
(match (download-package full-pkg-spec)
[(list #t path maj min)
(copy-file path pkg)
(printf "Downloaded ~a package version ~a.~a\n" pkg maj min)]
[_
(fail "Could not find matching package")])))
(parameterize ([download? #t])
(let* ([maj (read-from-string majstr)]
[min (read-from-string minstr)]
[full-pkg-spec (get-package-spec owner pkg maj min)])
(when (file-exists? pkg)
(fail "Cannot download, there is a file named ~a in the way" pkg))
(match (download-package full-pkg-spec)
[(list #t path maj min)
(copy-file path pkg)
(printf "Downloaded ~a package version ~a.~a\n" pkg maj min)]
[_
(fail "Could not find matching package")]))))
;; params->full-pkg-spec : string string string string -> pkg
;; gets a full package specifier for the given specification

View File

@ -90,12 +90,14 @@
;; download/install-pkg : string string nat nat -> pkg | #f
(define (download/install-pkg owner name maj min)
(let* ([pspec (pkg-spec->full-pkg-spec (list owner name maj min) #f)]
[upkg (get-package-from-server pspec)])
(cond
[(uninstalled-pkg? upkg)
(pkg-promise->pkg upkg)]
[else #f])))
(parameterize ([install? #t]
[download? #t])
(let* ([pspec (pkg-spec->full-pkg-spec (list owner name maj min) #f)]
[upkg (get-package-from-server pspec)])
(cond
[(uninstalled-pkg? upkg)
(pkg-promise->pkg upkg)]
[else #f]))))
;; current-cache-contents : -> ((string ((string ((nat (nat ...)) ...)) ...)) ...)
;; returns the packages installed in the local PLaneT cache