diff --git a/collects/planet/cachepath.ss b/collects/planet/cachepath.ss new file mode 100644 index 0000000000..1772533f7b --- /dev/null +++ b/collects/planet/cachepath.ss @@ -0,0 +1,14 @@ +(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 + ;; (n.b. this used to have the side effect of creating the path + ;; if it didn't exist, but since this function may be run at + ;; setup time and setup-time programs must not create this sort + ;; of directory, it doesn't do that anymore) + (define (get-planet-cache-path) + (let ((path (build-path (PLANET-DIR) "cache.ss"))) + path))) diff --git a/collects/planet/config.ss b/collects/planet/config.ss new file mode 100644 index 0000000000..77d3592e86 --- /dev/null +++ b/collects/planet/config.ss @@ -0,0 +1,24 @@ +(module config mzscheme + (require "private/define-config.ss") + (define-parameters + (PLANET-SERVER-NAME "planet.plt-scheme.org") + (PLANET-SERVER-PORT 270) + (PLANET-CODE-VERSION "300") + (PLANET-BASE-DIR (if (getenv "PLTPLANETDIR") + (string->path (getenv "PLTPLANETDIR")) + (build-path (find-system-path 'addon-dir) + "planet" + (PLANET-CODE-VERSION)))) + (PLANET-DIR (build-path (PLANET-BASE-DIR) (version))) + (CACHE-DIR (build-path (PLANET-DIR) "cache")) + (UNINSTALLED-PACKAGE-CACHE (build-path (PLANET-BASE-DIR) "packages")) + (LINKAGE-FILE (build-path (PLANET-DIR) "LINKAGE")) + (HARD-LINK-FILE (build-path (PLANET-BASE-DIR) "HARD-LINKS")) + (LOGGING-ENABLED? #t) + (LOG-FILE (build-path (PLANET-DIR) "INSTALL-LOG")) + (DEFAULT-PACKAGE-LANGUAGE (version)) + + (USE-HTTP-DOWNLOADS? #t) + (HTTP-DOWNLOAD-SERVLET-URL "http://planet.plt-scheme.org/servlets/planet-servlet.ss") + (PLANET-ARCHIVE-FILTER #f))) + diff --git a/collects/planet/info.ss b/collects/planet/info.ss new file mode 100644 index 0000000000..525d7e764a --- /dev/null +++ b/collects/planet/info.ss @@ -0,0 +1,6 @@ +#lang setup/infotab + +(define name "PLaneT") +(define mzscheme-launcher-names '("planet")) +(define mzscheme-launcher-libraries '("planet.ss")) +(define scribblings '(("planet.scrbl" (multi-page) (tool)))) diff --git a/collects/planet/lang/reader.ss b/collects/planet/lang/reader.ss new file mode 100644 index 0000000000..55d64755a1 --- /dev/null +++ b/collects/planet/lang/reader.ss @@ -0,0 +1,39 @@ +#lang scheme/base + +(require "../parsereq.ss") + +(provide (rename-out [planet-read read] + [planet-read-syntax read-syntax])) + +(define (planet-read-fn in spec->read-data) + (let* ([spec (read-line in)] + [parsed-spec + (with-handlers ([exn:parse-failure? (λ (e) (raise-syntax-error 'read "bad syntax"))]) + (parse-package-string spec))]) + (values + `(planet "lang/main.ss" ,parsed-spec) + (spec->read-data `(planet "lang/reader.ss" ,parsed-spec))))) + +(define (wrap port spec read) + (let* ([body + (let loop ([a null]) + (let ([v (read port)]) + (if (eof-object? v) + (reverse a) + (loop (cons v a)))))] + [p-name (object-name port)] + [name (if (path? p-name) + (let-values ([(base name dir?) (split-path p-name)]) + (string->symbol (path->string (path-replace-suffix name #"")))) + 'page)]) + `(module ,name ,spec + . ,body))) + +(define (planet-read [inp (current-input-port)]) + (define-values (spec r) (planet-read-fn inp (λ (spec) (dynamic-require spec 'read)))) + (wrap inp spec r)) + +(define (planet-read-syntax [src #f] [inp (current-input-port)]) + (define-values (spec r) (planet-read-fn inp (λ (spec) (dynamic-require spec 'read-syntax)))) + (wrap inp spec (lambda (p) (r src p)))) + diff --git a/collects/planet/parsereq.ss b/collects/planet/parsereq.ss new file mode 100644 index 0000000000..797619efec --- /dev/null +++ b/collects/planet/parsereq.ss @@ -0,0 +1,154 @@ +#lang scheme/base + +(require mzlib/match + "private/short-syntax-helpers.ss" + "private/data.ss") + +(provide (struct-out request) + parse-package-string + (struct-out exn:parse-failure) + spec->req + pkg-spec->full-pkg-spec + version->bounds + + string->longpkg + string->shortpkg + short-pkg-string->spec) + +(define-struct request (full-pkg-spec file path)) + +(define (tospec owner pkg maj min) + `(,owner ,pkg ,@(if maj (list maj) '()) ,@(if min (list min) '()))) + +(define-struct (exn:parse-failure exn:fail) ()) + +(define (string->longpkg s) + (let ([mtch (regexp-match #rx"^[ ]*([^ :/]+)[ ]+([^ :/]+)[ ]*([0-9]*)[ ]*([0-9]*)[ ]*$" s)]) + (if mtch + (let-values ([(owner pkg majstr minstr) (apply values (cdr mtch))]) + (tospec owner pkg + (if (string=? majstr "") #f (string->number majstr)) + (if (string=? minstr "") #f (string->number minstr)))) + #f))) + +(define (string->shortpkg s) + (define ((yell fmt) x) (raise (make-exn:parse-failure (format fmt x) (current-continuation-marks)))) + (with-handlers ([exn:parse-failure? (λ (e) #f)]) + (let* ([pkg-spec/tail (short-pkg-string->spec s yell)] + [pkg-spec (car pkg-spec/tail)] + [tail (cadr pkg-spec/tail)]) + (if (regexp-match #rx"^[ ]*$" tail) pkg-spec #f)))) + +(define all-parsers (list string->longpkg string->shortpkg)) + +;; parse-package-string : string -> pkg-spec +;; parses a "package name string", the kind of string that shows up in places where we're only interested +;; in naming a particular package, not a full path +(define (parse-package-string str) + (define (yell str) (raise (make-exn:parse-failure str (current-continuation-marks)))) + (ormap (λ (p) (p str)) all-parsers)) + +;; spec->req : sexp[require sexp] stx -> request +;; maps the given require spec to a planet package request structure +(define (spec->req spec stx) + (match (cdr spec) + [(file-name pkg-spec path ...) + (unless (string? file-name) + (raise-syntax-error #f (format "File name: expected a string, received: ~s" file-name) stx)) + (unless (andmap string? path) + ;; special-case to catch a possibly common error: + (if (ormap number? path) + (raise-syntax-error #f (format "Module path must consist of strings only, received a number (maybe you intended to specify a package version number?): ~s" path) stx) + (raise-syntax-error #f (format "Module path must consist of strings only, received: ~s" path) stx))) + (make-request (pkg-spec->full-pkg-spec pkg-spec stx) + file-name + path)] + [((? (lambda (x) (or (symbol? x) (string? x))) s)) + (let ([str (if (symbol? s) (symbol->string s) s)]) + (define (yell msg) (λ (str) (raise-syntax-error #f (format msg str) stx))) + (let* ([pkg-spec/tail (short-pkg-string->spec str yell)] + [pkg-spec (car pkg-spec/tail)] + [tail (cadr pkg-spec/tail)] + [fullspec (pkg-spec->full-pkg-spec pkg-spec stx)] + [final-path (if (string=? tail "") + "main.ss" + (string-append tail ".ss"))]) + (make-request fullspec final-path '())))] + [_ (raise-syntax-error 'require (format "Illegal PLaneT invocation: ~e" (cdr spec)) stx)])) + +;; short-pkg-string->spec : string (string -> string -> 'a) -> (list pkg-spec string) +;; extracts the named package from the given short-style string, returning +;; both that package spec and the leftover string +(define (short-pkg-string->spec str yell) + (try-parsing str + ([(consume-whitespace)] + [owner (get-next-slash #:on-error (yell "expected an owner, received ~e"))] + [package (get-next-slash-or-end #:on-error (yell "expected a package, received ~e"))]) + (λ (tail) + (let*-values ([(yell!) (yell "~a")] + [(pkg maj min) (parse-package package yell!)]) + (list (tospec owner pkg maj min) tail))))) + +; pkg-spec->full-pkg-spec : PKG-SPEC syntax -> FULL-PKG-SPEC +(define (pkg-spec->full-pkg-spec spec stx) + + (define (pkg name maj lo hi path) (make-pkg-spec name maj lo hi path stx (version))) + (define (fail* msg) + (raise-syntax-error 'require (string->immutable-string msg) stx)) + (define (fail) + (fail* (format "Invalid PLaneT package specifier: ~e" spec))) + + (match spec + [((? string? owner) (? string? package) ver-spec ...) + (match-let ([(maj min-lo min-hi) (version->bounds ver-spec fail*)]) + (pkg package maj min-lo min-hi (list owner)))] + [((? (o not string?) owner) _ ...) + (fail* (format "Expected string [package owner] in first position, received: ~e" owner))] + [(_ (? (o not string?) pkg) _ ...) + (fail* (format "Expected string [package name] in second position, received: ~e" pkg))] + [_ (fail)])) + + +;; version->bounds : VER-SPEC -> (list (number | #f) number (number | #f)) | #f +;; determines the bounds for a given version-specifier +;; [technically this handles a slightly extended version of VER-SPEC where MAJ may +;; be in a list by itself, because that's slightly more convenient for the above fn] +(define (version->bounds spec-list fail) + (match spec-list + [() (list #f 0 #f)] + [(? number? maj) (version->bounds (list maj))] + [((? number? maj)) (list maj 0 #f)] + [((? number? maj) min-spec) + (let ((pkg (lambda (min max) (list maj min max)))) + (match min-spec + [(? number? min) (pkg min #f)] + [((? number? lo) (? number? hi)) (pkg lo hi)] + [('= (? number? min)) (pkg min min)] + [('+ (? number? min)) (pkg min #f)] + [('- (? number? min)) (pkg 0 min)] + + ;; failure cases + [(? (o/and (o not number?) + (o/or (o not list?) + (λ (x) (not (= (length x) 2)))))) + (fail (format "Expected number or version range specifier for minor version specification, received: ~e" min-spec))] + [((? (λ (x) + (and (not (number? x)) + (not (memq x '(= + -))))) + range) + _) + (fail (format "Illegal range specifier in minor version specification. Legal range specifiers are numbers, =, +, -; given: ~e" range))] + [(_ (? (o not number?) bnd)) + (fail (format "Expected number as range bound in minor version specification, given: ~e" bnd))] + [_ (fail (format "Illegal minor version specification: ~e" min-spec))]))] + + ;; failure cases + [(? (o/and (o not number?) (o not list?)) v) + (fail (format "Version specification expected number or sequence, received: ~e" v))] + [((? (o not number?) maj) _ ...) + (fail (format "Version specification expected number for major version, received: ~e" maj))] + [_ (fail "Invalid version specification")])) + +(define (o f g) (λ (x) (f (g x)))) +(define (o/and . es) (λ (x) (andmap (λ (f) (f x)) es))) +(define (o/or . es) (λ (x) (ormap (λ (f) (f x)) es))) diff --git a/collects/planet/planet-archives.ss b/collects/planet/planet-archives.ss new file mode 100644 index 0000000000..dd8480a3cd --- /dev/null +++ b/collects/planet/planet-archives.ss @@ -0,0 +1,60 @@ +(module planet-archives mzscheme + (require "private/planet-shared.ss" + mzlib/file + "config.ss" + "cachepath.ss") + + (provide repository-tree + get-installed-planet-archives + get-hard-linked-packages + get-all-planet-packages + get-planet-cache-path) + + (define (repository-tree) + (define (id x) x) + (filter-tree-by-pattern + (directory->tree (CACHE-DIR) + (lambda (x) + (not (regexp-match #rx"/(CVS|[.]svn)$" + (path->string x)))) + 4) + (list id id id string->number string->number))) + + ;; get-installed-planet-dirs : -> listof (list path[absolute, dir] string string (listof string) nat nat) + ;; directories of all normally-installed planet archives [excluding hard links] + (define (get-installed-planet-archives) + (with-handlers ((exn:fail:filesystem:no-directory? (lambda (e) '()))) + (tree-apply + (lambda (rep-name owner package maj min) + (let ((x (list + (build-path (CACHE-DIR) owner package (number->string maj) (number->string min)) + owner + package + '() + maj + min))) + x)) + (repository-tree) + 3))) + + ;; get-hard-linked-packages : -> listof (list path[absolute, dir] string string (listof string) nat nat) + ;; directories of all hard-linked packages + (define (get-hard-linked-packages) + (map + (lambda (row) + (map (lambda (f) (f row)) + (list assoc-table-row->dir + (lambda (r) (car (assoc-table-row->path r))) + assoc-table-row->name + (lambda (r) (cdr (assoc-table-row->path r))) + assoc-table-row->maj + assoc-table-row->min))) + (get-hard-link-table))) + + ;; get-all-planet-packages : -> listof (list path[absolute, dir] string string (listof string) nat nat) + ;; get every planet package, regardless of origin + (define (get-all-planet-packages) + (append (get-installed-planet-archives) + (get-hard-linked-packages))) + + ) diff --git a/collects/planet/planet.scrbl b/collects/planet/planet.scrbl new file mode 100644 index 0000000000..ea4b1e9fea --- /dev/null +++ b/collects/planet/planet.scrbl @@ -0,0 +1,879 @@ +#lang scribble/doc + +@(require scribble/manual + scribble/bnf + scribble/eval + (for-label scheme) + (for-label planet/config) + (for-label planet/util)) + +@(define-syntax-rule (eg (code resl) ...) + (interaction + (eval:alts code resl) + ...)) + +@title{@bold{PLaneT}: Automatic Package Distribution} + +@PLaneT is PLT Scheme's centralized package repository. It consists of +two parts: , which contains packages contributed by users, and +the @PLaneT client, which is built in to PLT Scheme. + +The @PLaneT system is a method for automatically sharing code packages, +both as libraries and as full applications, that gives every user of a +@PLaneT client the illusion of having a local copy of every code +package on the server. It +consists of @link["http://planet.plt-scheme.org/"]{the central @PLaneT +package repository}, a server that holds all PLaneT packages, and +the PLaneT client, built into PLT Scheme, which transparently +interacts with the server on your behalf when necessary. + +@table-of-contents[] + +@section{Using PLaneT} + +To use a @PLaneT package in a program, require it using the +@scheme[planet] @scheme[require] form (see @(secref "require" #:doc +'(lib "scribblings/reference/reference.scrbl")) for a full reference +on the features of the @scheme[require] statement in general and the +exact allowed grammar of PLaneT require statements). Here we explain +how to use PLaneT by example. + +@subsection[#:tag "finding-a-package"]{Finding a Package} + +If you are new to PLaneT, the first thing to to is visit +@link["http://planet.plt-scheme.org/"]{the PLaneT repository web site} +and see what packages are available. People contribute new PLaneT +packages all the time --- if you want to be notified whenever a new or +updated package is released, you can subscribe to the +(announcement-only) +@link["http://mailman.cs.uchicago.edu/mailman/listinfo/planet-announce"]{PLaneT-announce mailing list} +or use an RSS reader to subscribe to +@link["http://planet.plt-scheme.org/300/planet.rss"]{PLaneT's RSS feed}. + +To use a package from PLaneT in your program, the easiest thing to do +is copy the @scheme[require] code snippet off of that package's page +and paste it ino your program. For instance, to use Schematics' +@link["http://planet.plt-scheme.org/users/schematics/spgsql.plt"]{spgsql.plt} +package (a library for interacting with the +@link["http://www.postgresql.org/"]{PostgresQL} database), as of this +writing you would copy and paste the line: + +@scheme[(require (planet "spgsql.ss" ("schematics" "spgsql.plt" 2 3)))] + +into your program. This line requires the file @filepath{spgsql.ss} in package +version 2.3 of the @filepath{spgsql.plt} package written by +@filepath{schematics}. That does two things: first, it downloads and +installs a version of @filepath{spgsql.plt} that is compatible with +package version 2.3 from @link["http://planet.plt-scheme.org/"]{the +central PLaneT repository} if a compatible version hasn't already been +installed. Second, it requires the module in file @filepath{spgsql.ss} +from that package, making all of its exported bindings available for use. + +Unlike with most package-distribution systems, package downloading and +installation in PLaneT is @italic{transparent} --- there's no need for +you to do anything special the first time you want to use a package, +and there's no need for you to even know whether or not a particular +package is installed on your computer or the computers where your code +will be deployed. + +@subsection{Shorthand Syntax} + +As of PLT Scheme version 4.0, the code snippet in section +@secref{finding-a-package} can also be written using a new shorter syntax: + +@scheme[(require (planet schematics/spgsql:2:3/spgsql))] + +The two forms behave identically. In the abbreviated syntax, however, +it is illegal to write the trailing @scheme{.ss} suffix on the file +name to be required or the trailing @scheme{.plt} on the package file +name. (They are mandatory for the long-form syntax.) It is also legal +in the abbreviated syntax to omit a filename to be required entirely; +in that case, PLaneT requires the file @scheme{main.ss} in the given +package. + +@subsection{Fine-Grained Control Over Package Imports} + +The PLaneT client is designed to balance two competing goals: +transparent upgradability and control over the effect of a package +requirement. To that end, the most basic PLaneT require form offers +maximum upgradability, but several more specialized forms allow +finer-grained control over what versions of the named package may be +downloaded. + +@margin-note{Package versions should not be confused with program or library +versions; a @italic{package version} is a PLaneT-specific version +number that encodes backwards-compatibility information.} + +The most basic planet require line, which is what is used in the form + +@scheme[(require (planet "spgsql.ss" ("schematics" "spgsql.plt" 2 3)))] + +in longhand notation, or + +@scheme[(require (planet schematics/spgsql:2:3/spgsql))] + +in shorthand notation, should be read ``Require from PLaneT +@italic{any} release of Schematics' @filepath{spgsql.plt} package that +is backwards-compatible with package version 2.3.'' (The actual +package version used is determined by @seclink["search-order"]{the +PLaneT search order}.) To signal this explicitly, it is possible to +write + +@scheme[(require (planet "spgsql.ss" ("schematics" "spgsql.plt" 2 (+ 3))))] + +or + +@scheme[(require (planet schematics/spgsql:2:>=3/spgsql))] + +both of which mean the same thing as the first pair of require lines. + +@margin-note{See @secref{backwards-compatibility} for a more detailed discussion of +backwards-compatibility obligations for PLaneT packages.} +The notion of ``backwards-compatibility'' has a specific meaning in +PLaneT: by definition, for the purposes of automation, a package is +considered to be backwards-compatible with any other package of the +same owner, name, and major version, and any @italic{lower} minor +version. Package maintainers are responsible for marking new releases +that break backwards-compatibility by incrementing their major-version +number. This means that all of the above require specifications will +match any release of @filepath{unlib.plt} with major package version 3 +(and any minor version), but will @italic{never} match releases of +@filepath{unlib.plt} with higher (or lower) major version numbers. + +Of course a package author may make a mistake and introduced a +backwards-incompatibility unintentionally, or may fix a bug that code +in third-party libraries was already working around. In those cases, +it may help to make use of the ``upper bound'' form of the planet +require, in longhand form: + +@scheme[(require (planet "reduction-semantics.ss" ("robby" "redex.plt" 4 (- 3))))] + +and using shorthand notation: + +@scheme[(require (planet robby/redex:4:<=3/reduction-semantics))] + +In this require line, any version of the package @filepath{redex.plt} +from package version 4.0 to package version 4.3 will match the require +spec (though as with any PLaneT require specification, +@seclink["search-order"]{the PLaneT package search order} determines +which package is actually loaded). + +It is also possible to specify both an upper and a lower bound, using +the planet require's ``range'' form: + +@scheme[(require (planet "test.ss" ("schematics" "schemeunit.plt" 2 (9 10))))] + +or + +@scheme[(require (planet schematics/schemeunit:2:9-10/test))] + +This form matches any package in the specified range (inclusive on +both ends), in this example the specifications match either package +version 2.9 or 2.10 of the @filepath{schemeunit.plt} package, but do +not match version with higher or lower minor version numbers (or any +other major version number). + +Using the range form, it is possible to require a specific version of +a package as a special case (choosing the upper and lower bounds to be +equal), but this is a common enough case that it has special support +with the ``exact-match'' form: + +@scheme[(require (planet "unzip.ss" ("dherman" "zip.plt" 2 (= 1))))] + +or + +@scheme[(require (planet dherman/zip:2:=1/unzip))] + +match only the exact package version 2.1 of the @filepath{zip.plt} package. + +@;@subsection{Linkage} + +@;@subsection{The Diamond Property} + + +@section[#:tag "search-order"]{The PLaneT Search Order} + +PLaneT has four strategies it uses in order to match a request with an +appropriate package that. + +@subsection{Previous Linkage} + +Whenever a file requires a package via PLaneT and that requirement is +satisfied, the system makes a note of exactly which package satisfied +that requirement and from then on always uses that exact same package, +even if a newer version is available. This is done to prevent "magic +upgrades" in which a program stops working after installation because +an unrelated package was installed. Such connections are called links +and are stored in a user-specific table called the linkage table. + +@subsection{Acceptable Local Package} + +If the PLaneT client doesn't have any previous linkage information, it +checks its list of already-installed PLaneT packages for one that +meets the requirement, and uses it if available. Both PLaneT-installed +packages and packages established through a development link +(see @secref{devlinks}) +are checked simultaneously at this stage. + +@subsection{Acceptable Remote Package} + +If there is no acceptable local package, the PLaneT client sends +a request to the PLaneT server for a new package that would satisfy +the requirement. The server then finds the newest matching package +and sends it back to the client, which then installs it and uses +it to satisfy the original requirement. + +@subsection{Cached Installation Archive} + +If the remote server cannot be contacted (or fails in any way to +deliver an acceptable package), the PLaneT client consults the +uninstalled-packages cache, a cache of all previously-downloaded +packages, even those that are not currently installed. PLT Scheme +users who frequently upgrade their installations may have many +packages downloaded but not installed at any given time; this step +is intended to ensure that these users can still run programs even +if they temporarily lose network connection. + +@section[#:tag "cmdline"]{The @exec{planet} Command-Line Tool} + +The @exec{planet} command-line tool allows a command-line interface to +the most commonly-performed PLaneT tasks. It is invoked from the +command line as + +@commandline{planet @italic{subcommand} arg ...} + +where @italic{command} is a subcommand from the following list, and +@exec{arg} is a sequence of arguments determined by that subcommand: + +@(define (cmd name desc) + @item{@(seclink name (exec name)): @desc}) + +@itemize{ + @cmd["create"]{create a PLaneT archive from a directory} + @cmd["install"]{download and install a given package} + @cmd["remove"]{remove the specified package from the local cache} + @cmd["show"]{list the packages installed in the local cache} + @cmd["clearlinks"]{clear the linkage table, allowing upgrades} + @cmd["fileinject"]{install a local file to the planet cache} + @cmd["link"]{create a development link} + @cmd["unlink"]{remove development link associated with the given package} + @cmd["fetch"]{download a package file without installing it} + @cmd["url"]{get a URL for the given package} + @cmd["open"]{unpack the contents of the given package} + @cmd["structure"]{display the structure of a given .plt archive} + @cmd["print"]{display a file within of the given .plt archive}} + +Each of these commands is described in more detail below. All the +functionality of the command-line tool is also provided with a programmatic interface by +@seclink["util.ss"]{the @filepath{util.ss} library}. + +@subsection[#:tag "create"]{@exec{create}} + +Usage: +@commandline{planet create [