From 879307289b7d5f13bdbb2d73c61fec9f27493391 Mon Sep 17 00:00:00 2001 From: Jacob Matthews Date: Tue, 24 Jan 2006 20:15:37 +0000 Subject: [PATCH] A bug fix, an error-message improvement, and new docs. svn: r1947 --- collects/planet/doc.txt | 50 ++++++++++++-- collects/planet/private/planet-shared.ss | 86 ++++++++++++------------ collects/planet/resolver.ss | 8 +++ 3 files changed, 97 insertions(+), 47 deletions(-) diff --git a/collects/planet/doc.txt b/collects/planet/doc.txt index 01c1ef6bb5..ebaf7d3e21 100644 --- a/collects/planet/doc.txt +++ b/collects/planet/doc.txt @@ -42,6 +42,15 @@ VER-SPEC is provided, the most recent version is assumed. If no owner-name/path ... clause is provided, the default package is assumed. +For example, + + (require (planet "test-connection.ss" ("planet" "test-connection.plt" 1 0))) + +requires the file "test-connection.ss" from the package owned by +"planet" called "test-connection.plt", and says that any package with +major version 1 and any minor version greater than or equal to 0 will +do. + _config.ss_: client configuration This file provides several parameters useful for configuring how @@ -147,6 +156,25 @@ numbers and major-version must be greater than zero. Removes the entire linkage table from the system, which will force all modules to relink themselves to PLaneT modules the next time they run. +> (add-hard-link owner name major-version minor-version directory) -> void + +Adds a development link between the specified package and the given +directory; once a link is established, PLaneT will treat the cache as +having a package with the given owner, name, and version whose files +are located in the given path. This is intended for package +development; users only interested in using PLaneT packages +available online should not need to create any development links. + +owner and name must be strings, major-version and minor-version must +be natural numbers, and directory must be a path (not a string) +indicating a directory. + +If the specified package already has a development link, this function +first removes the old link and then adds the new one. + +> (remove-hard-link owner name major-version minor-version) -> void + +Removes any hard link that may be associated with the given package. _The PLaneT search order_ ------------------------- @@ -365,13 +393,25 @@ the name (without path) of the main Scheme source file of your package. PLaneT will direct casual users of your library to require this file. +The _'required-core-version field_ + +If present, the required-core-version field should be a string with +the same syntax as the output of mzscheme's built-in (version) +function. Defining this field indicates that PLaneT should only allow +users of a version of mzscheme equal to or more recent than the +version specified by this field. This allows you finer-grained control +of your package's core-language requirements than its inclusion in a +particular repository; for instance, setting this field to "300.2" +would cause the PLaneT server not to serve it to MzScheme v300 +clients. + The _'version field_ -If present, the version field should describe the version number -of this code that should be presented to users (e.g., "0.15 alpha"). -This field does not override or in any way interact with your package's -package version number, which is assigned by PLaneT, but may be useful -to users. +If present, the version field should describe the version number of +this code that should be presented to users (e.g., "0.15 alpha"). +This field does not override or in any way interact with your +package's package version number, which is assigned by PLaneT, but may +be useful to users. In addition, PLaneT uses the setup-plt installer to install packages diff --git a/collects/planet/private/planet-shared.ss b/collects/planet/private/planet-shared.ss index 7325b48b60..c60ceb9ef6 100644 --- a/collects/planet/private/planet-shared.ss +++ b/collects/planet/private/planet-shared.ss @@ -22,7 +22,7 @@ Various common pieces of code that both the client and server need to access ; CACHE LOGIC ; Handles checking the cache for an appropriate module ; ========================================================================================== - + ; language-version->repository : string -> string | #f ; finds the appropriate language version for the given repository (define (language-version->repository ver) @@ -93,8 +93,8 @@ Various common pieces of code that both the client and server need to access (tree-apply tree-stuff->row-or-false (directory->tree path (λ (x) #t) 2 (λ (x) x)))) - empty-table)) - + empty-table)) + ; the link table format: ; (listof (list string[name] (listof string[path]) num num bytes[directory]) @@ -125,7 +125,7 @@ Various common pieces of code that both the client and server need to access (lambda (item) (update-element 4 bytes->path item)) (with-input-from-file (HARD-LINK-FILE) read-all)) '())) - + ;; row-for-package? : row string (listof string) num num -> boolean ;; determines if the row associates the given package with a dir (define (points-to? row name path maj min) @@ -164,14 +164,14 @@ Various common pieces of code that both the client and server need to access ;; removes all rows from the link table that don't match the given predicate (define (filter-link-table! f) (save-hard-link-table (filter f (get-hard-link-table)))) - + ;; update-element : number (x -> y) (listof any [x in position number]) -> (listof any [y in position number]) (define (update-element n f l) (cond [(null? l) (error 'update-element "Index too large")] [(zero? n) (cons (f (car l)) (cdr l))] [else (cons (car l) (update-element (sub1 n) f (cdr l)))])) - + ; add-to-table assoc-table (listof assoc-table-row) -> assoc-table (define add-to-table append) @@ -198,7 +198,7 @@ Various common pieces of code that both the client and server need to access (list name path maj min dir required-version)) (define-struct mz-version (major minor)) - + ;; string->mz-version : string -> mz-version | #f (define (string->mz-version str) (let ((ver (regexp-match #rx"^([0-9]+)(\\.([0-9]+))?$" str))) @@ -218,7 +218,7 @@ Various common pieces of code that both the client and server need to access (or (<= (mz-version-major a) (mz-version-major b)) (and (= (mz-version-major a) (mz-version-major b)) (<= (mz-version-minor a) (mz-version-minor b))))) - + ;; compatible-version? : assoc-table-row FULL-PKG-SPEC -> boolean ;; determines if the given package constrint verstr can support the given package (define (compatible-version? row spec) @@ -229,39 +229,41 @@ Various common pieces of code that both the client and server need to access (or (not required) (not provided) (version<= required provided)))))) - + ; get-best-match : assoc-table FULL-PKG-SPEC -> PKG | #f ; return the best on-disk match for the given package spec (define (get-best-match table spec) - (let* ((target-maj - (or (pkg-spec-maj spec) - (apply max (map assoc-table-row->maj table)))) - (lo (pkg-spec-minor-lo spec)) - (hi (pkg-spec-minor-hi spec)) - (matches - (filter - (λ (x) - (let ((n (assoc-table-row->min x))) - (and - (equal? target-maj (assoc-table-row->maj x)) - (or (not lo) (>= n lo)) - (or (not hi) (<= n hi)) - (compatible-version? x spec)))) - table))) - (if (null? matches) - #f - (let ((best-row - (car - (quicksort - matches - (λ (a b) (> (assoc-table-row->min a) (assoc-table-row->min b))))))) - (make-pkg - (pkg-spec-name spec) - (pkg-spec-path spec) - (assoc-table-row->maj best-row) - (assoc-table-row->min best-row) - (assoc-table-row->dir best-row)))))) - + (if (null? table) + #f + (let* ((target-maj + (or (pkg-spec-maj spec) + (apply max (map assoc-table-row->maj table)))) + (lo (pkg-spec-minor-lo spec)) + (hi (pkg-spec-minor-hi spec)) + (matches + (filter + (λ (x) + (let ((n (assoc-table-row->min x))) + (and + (equal? target-maj (assoc-table-row->maj x)) + (or (not lo) (>= n lo)) + (or (not hi) (<= n hi)) + (compatible-version? x spec)))) + table))) + (if (null? matches) + #f + (let ((best-row + (car + (quicksort + matches + (λ (a b) (> (assoc-table-row->min a) (assoc-table-row->min b))))))) + (make-pkg + (pkg-spec-name spec) + (pkg-spec-path spec) + (assoc-table-row->maj best-row) + (assoc-table-row->min best-row) + (assoc-table-row->dir best-row))))))) + ; FULL-PKG-SPEC : (make-pkg-spec string (Nat | #f) (Nat | #f) (Nat | #f) (listof string) (syntax | #f)) string (define-struct pkg-spec (name maj minor-lo minor-hi path stx core-version) (make-inspector)) ; PKG : string Nat Nat path @@ -295,8 +297,8 @@ Various common pieces of code that both the client and server need to access (begin (set! to-read (- to-read bytes-read)) bytes-read)))])) - #f - void)))) + #f + void)))) ; write-line : X output-port -> void ; writes the given value followed by a newline to the given port @@ -364,7 +366,7 @@ Various common pieces of code that both the client and server need to access (hash-table-put! ht key (cons i (hash-table-get ht key (lambda () '())))))) l) (hash-table-map ht cons))) - + (define (drop-last l) (reverse (cdr (reverse l)))) ;; note: this can be done faster by reading a copy-port'ed port with @@ -418,7 +420,7 @@ Various common pieces of code that both the client and server need to access '() (let ((next-depth (if max-depth (sub1 max-depth) #f))) (map (lambda (d) (directory->tree d valid-dir? next-depth)) files)))))))) - + ;; filter-pattern : (listof pattern-term) ;; pattern-term : (x -> y) | (make-star (tst -> bool) (x -> y)) (define-struct star (pred fun)) diff --git a/collects/planet/resolver.ss b/collects/planet/resolver.ss index 636eef8822..fbb9e1ac6c 100644 --- a/collects/planet/resolver.ss +++ b/collects/planet/resolver.ss @@ -471,6 +471,14 @@ attempted to load version ~a.~a while version ~a.~a was already loaded" (list #f (format "Server had no matching package: ~a" (read-line ip)))] [(400) (abort (format "Internal error (malformed request): ~a" (read-line ip)))] + [(500) + (abort (format "Server internal error: ~a" + (apply string-append + (let loop () + (let ((line (read-line ip))) + (cond + [(eof-object? line) '()] + [else (list* line "\n" (loop))]))))))] [else (abort (format "Internal error (unknown HTTP response code ~a)" response-code))])))