diff --git a/Makefile b/Makefile index 6a3ccb06fe..88faa3684b 100644 --- a/Makefile +++ b/Makefile @@ -99,7 +99,7 @@ error-need-prefix: LOC_CATALOG = build/local/pkgs-catalog local-catalog: - "$(DESTDIR)$(PREFIX)/bin/racket" racket/src/pkgs-catalog.rkt $(LOC_CATALOG) pkgs + "$(DESTDIR)$(PREFIX)/bin/racket" -l- pkg/dirs-catalog --check-metadata $(LOC_CATALOG) pkgs "$(DESTDIR)$(PREFIX)/bin/raco" pkg catalog-copy --force --from-config $(LOC_CATALOG) $(UNIX_CATALOG) # ------------------------------------------------------------ @@ -287,7 +287,7 @@ WIN32_BUNDLE_RACO = bundle\racket\racket $(BUNDLE_RACO_FLAGS) # ------------------------------------------------------------ # Linking all packages (development mode; not an installer build) -PKGS_CATALOG = -U -G build/config racket/src/pkgs-catalog.rkt --link +PKGS_CATALOG = -U -G build/config -l- pkg/dirs-catalog --link --check-metadata PKGS_CONFIG = -U -G build/config racket/src/pkgs-config.rkt pkgs-catalog: diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/apis.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/apis.scrbl index aca461d741..140c4224e3 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/apis.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/apis.scrbl @@ -50,3 +50,4 @@ to the @exec{raco pkg} sub-subcommands. @include-section["path.scrbl"] @include-section["name.scrbl"] @include-section["db.scrbl"] +@include-section["dirs-catalog.scrbl"] diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/dirs-catalog.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/dirs-catalog.scrbl new file mode 100644 index 0000000000..f6ca5ccadb --- /dev/null +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/dirs-catalog.scrbl @@ -0,0 +1,59 @@ +#lang scribble/manual +@(require "common.rkt" + scribble/bnf + (for-label pkg/dirs-catalog + racket/base + racket/contract/base)) + +@title[#:tag "dirs-catalog"]{Package Directories Catalog} + +@defmodule[pkg/dirs-catalog]{The @racketmodname[pkg/dirs-catalog] module +provides @racket[create-dirs-catalog], which generates a @tech{package +catalog} (as a directory) that refers to a set of packages that are +found in a given set of directories. Packages are discovered in the +given directory as subdirectories that have an @filepath{info.rkt} +file.} + +For example, the main Racket development repository includes a +@filepath{pkgs} directory that holds packages such as @pkgname{base}, +and @racket[create-dirs-catalog] constructs a catalog to be used to +install those packages. + +When run directly as a program, @racketmodname[pkg/dirs-catalog] expects a +destination catalog followed by any number paths for directories that +hold packages: + +@commandline{racket -l- pkg/dirs-catalog @nonterm{dest-catalog} @nonterm{dir} ...} + +The @DFlag{link}, @DFlag{merge}, @DFlag{check-metadata}, and +@DFlag{quiet} flags correspond to optional keyword arguments of +@racket[create-dirs-catalog]. + +@history[#:added "6.1.1.6"] + +@defproc[(create-dirs-catalog [catalog-path path-string?] + [dirs (listof path-string?)] + [#:link? link? any/c #f] + [#:merge? merge? any/c #f] + [#:check-metadata? check-metadata? any/c #f] + [#:status-printf status-printf (string? any/c ... -> void?) void]) + void?]{ + +Creates or modifies @racket[catalog-path] as a directory that works as +a catalog (see @secref["catalog-protocol"]) to list the packages that +are contained in each directory specified by @racket[dirs]. Packages +are discovered in @racket[dirs] as subdirectories that have an +@filepath{info.rkt} file. + +If @racket[link?] is true, then the catalog specifies that the package +should be installed as a directory link, as opposed to copies. + +If @racket[merge?] is true, then existing catalog entries in +@racket[catalog-path] are preserved, otherwise old catalog entries are +removed. + +To create author and description information for each package in the +catalog, @racket[create-dirs-catalog] looks for a @racket[pkg-authors] +and @racket[pkg-desc] definition in each package's @filepath{info.rkt} +file. If either definition is missing and @racket[check-metadata?] is +true, an error is reported.} diff --git a/racket/collects/pkg/dirs-catalog.rkt b/racket/collects/pkg/dirs-catalog.rkt new file mode 100644 index 0000000000..c65d605592 --- /dev/null +++ b/racket/collects/pkg/dirs-catalog.rkt @@ -0,0 +1,162 @@ +#lang racket/base +(require racket/cmdline + racket/file + racket/format + racket/string + racket/path + setup/getinfo + pkg/lib) + +;; Find packages in a directory tree, where "info.rkt" indicates a +;; package, and create a catalog that points to those packages --- to +;; be installed as links if `--link` is specified. + +(provide create-dirs-catalog) + +(module+ main + (define link? #f) + (define merge? #f) + (define check-metadata? #f) + (define quiet? #f) + + (command-line + #:once-each + ["--link" "Install packages as links" + (set! link? #t)] + ["--merge" "Preserve existing packages in catalog" + (set! merge? #t)] + ["--check-metadata" "Complain if metadata (author and description) is missing" + (set! check-metadata? #t)] + [("--quiet" "-q") "Avoid status printouts" + (set! quiet? #t)] + #:args + (catalog-path . dir) + (create-dirs-catalog catalog-path + ;; a list: + dir + #:status-printf (if quiet? void printf) + #:link? link? + #:merge? merge? + #:check-metadata? check-metadata?))) + +(define (create-dirs-catalog catalog-path + dirs + #:status-printf [status-printf void] + #:link? [link? #f] + #:merge? [merge? #f] + #:check-metadata? [check-metadata? #f]) + ;; found: maps each available package name to a directory + (define found (make-hash)) + + (status-printf "Finding packages\n") + + ;; Recur through directory tree, and treat each directory + ;; that has an "info.rkt" file as a package (and don't recur + ;; further into the package) + (for ([src-dir (in-list dirs)]) + (when (directory-exists? src-dir) + (let loop ([src-dir src-dir]) + (for ([f (in-list (directory-list src-dir))]) + (define src-f (build-path src-dir f)) + (cond + [(file-exists? (build-path src-f "info.rkt")) + (define f-name (path->string f)) + (when (hash-ref found f-name #f) + (error 'pack-local + "found package ~a multiple times: ~a and ~a" + f-name + (hash-ref found f-name) + src-f)) + (hash-set! found f-name src-f)] + [(directory-exists? src-f) + (loop src-f)]))))) + + (unless merge? + (when (directory-exists? (build-path catalog-path "pkg")) + (for ([l (directory-list (build-path catalog-path "pkg"))]) + (unless (hash-ref found (path->string l) #f) + (status-printf " Uncataloging package ~a\n" (path->string l)) + (delete-directory/files (build-path catalog-path "pkg" l)))))) + + (define metadata-ns (make-base-namespace)) + (define (get-pkg-info pkg-dir) + (get-info/full pkg-dir + #:namespace metadata-ns + #:bootstrap? #t)) + + (define missing-desc null) + (define missing-authors null) + + (define (relative-path->relative-url p) + (apply ~a #:separator "/" + (map (lambda (e) + (case e + [(up) ".."] + [(same) "."] + [else (path-element->string e) e])) + (explode-path p)))) + + (for ([(pkg-name dir) (in-hash found)]) + (define i (get-pkg-info dir)) + (define deps + (extract-pkg-dependencies i)) + (define desc (i 'pkg-desc (lambda _ #f))) + (unless (string? desc) + (set! missing-desc (cons pkg-name missing-desc))) + (define authors (i 'pkg-authors (lambda _ null))) + (unless (and (list? authors) + ((length authors) . >= . 1)) + (set! missing-authors (cons pkg-name missing-authors))) + (define pkg + `#hash((name . ,pkg-name) + (source . ,(string-append + (relative-path->relative-url + (find-relative-path (simple-form-path + (path->complete-path catalog-path)) + (simple-form-path + (path->complete-path dir)))) + (if link? + "?type=static-link" + ""))) + (author . ,(string-join (for/list ([r authors]) + (if (symbol? r) + (format "~a@racket-lang.org" r) + r)) + " ")) + (checksum . "") + (description . ,(or desc "???")) + (tags . ()) + (dependencies . ,deps) + (modules . ,(pkg-directory->module-paths + dir + pkg-name + #:namespace metadata-ns)))) + (define pkg-file (build-path catalog-path "pkg" pkg-name)) + (define exists? (file-exists? pkg-file)) + (cond + [(and exists? + (equal? (with-handlers ([exn:fail:read? void]) + (call-with-input-file* pkg-file read)) + pkg)) + ;; No change + (void)] + [else + (status-printf " ~aataloging package ~a\n" + (if exists? "Rec" "C") + pkg-name) + (make-directory* (build-path catalog-path "pkg")) + (call-with-output-file* + pkg-file + #:exists 'truncate/replace + (lambda (o) + (write pkg o) + (newline o)))])) + + (for ([p (in-list missing-desc)]) + (status-printf "Missing package description for ~a\n" p)) + (for ([p (in-list missing-authors)]) + (status-printf "Missing package authors for ~a\n" p)) + + (when check-metadata? + (unless (and (null? missing-authors) (null? missing-desc)) + (error 'link-all "not all packages have description and authors.")))) diff --git a/racket/src/pkgs-catalog.rkt b/racket/src/pkgs-catalog.rkt deleted file mode 100644 index 15d6508b03..0000000000 --- a/racket/src/pkgs-catalog.rkt +++ /dev/null @@ -1,139 +0,0 @@ -#lang racket/base -(require racket/cmdline - racket/file - racket/format - racket/string - racket/path - setup/getinfo - pkg/lib) - -;; Find packages in a directory tree ("info.rkt" indicates a package), -;; create a catalog that points to those packages --- to be installed as -;; links if `--link` is specified. - -;; Used by the top-level Makefile in the main Racket repository. - -(define link? #f) - -(define-values (catalog-path dirs) - (command-line - #:once-each - ["--link" "Install packages as links" - (set! link? #t)] - #:args - (catalog-path . dir) - (values catalog-path dir))) - -;; found: maps each available package name to a directory -(define found (make-hash)) - -(printf "Finding packages\n") - -;; Recur through directory tree, and treat each directory -;; that has an "info.rkt" file as a package (and don't recur -;; further into the package) -(for ([src-dir (in-list dirs)]) - (when (directory-exists? src-dir) - (let loop ([src-dir src-dir]) - (for ([f (in-list (directory-list src-dir))]) - (define src-f (build-path src-dir f)) - (cond - [(file-exists? (build-path src-f "info.rkt")) - (define f-name (path->string f)) - (when (hash-ref found f-name #f) - (error 'pack-local - "found package ~a multiple times: ~a and ~a" - f-name - (hash-ref found f-name) - src-f)) - (hash-set! found f-name src-f)] - [(directory-exists? src-f) - (loop src-f)]))))) - -(when (directory-exists? (build-path catalog-path "pkg")) - (for ([l (directory-list (build-path catalog-path "pkg"))]) - (unless (hash-ref found (path->string l) #f) - (printf " Uncataloging package ~a\n" (path->string l)) - (delete-directory/files (build-path catalog-path "pkg" l))))) - -(define metadata-ns (make-base-namespace)) -(define (get-pkg-info pkg-dir) - (get-info/full pkg-dir - #:namespace metadata-ns - #:bootstrap? #t)) - -(define missing-desc null) -(define missing-authors null) - -(define (relative-path->relative-url p) - (apply ~a #:separator "/" - (map (lambda (e) - (case e - [(up) ".."] - [(same) "."] - [else (path-element->string e) e])) - (explode-path p)))) - -(for ([(pkg-name dir) (in-hash found)]) - (define i (get-pkg-info dir)) - (define deps - (extract-pkg-dependencies i)) - (define desc (i 'pkg-desc (lambda _ #f))) - (unless (string? desc) - (set! missing-desc (cons pkg-name missing-desc))) - (define authors (i 'pkg-authors (lambda _ null))) - (unless (and (list? authors) - ((length authors) . >= . 1)) - (set! missing-authors (cons pkg-name missing-authors))) - (define pkg - `#hash((name . ,pkg-name) - (source . ,(string-append - (relative-path->relative-url - (find-relative-path (simple-form-path - (path->complete-path catalog-path)) - (simple-form-path - (path->complete-path dir)))) - (if link? - "?type=static-link" - ""))) - (author . ,(string-join (for/list ([r authors]) - (if (symbol? r) - (format "~a@racket-lang.org" r) - r)) - " ")) - (checksum . "") - (description . ,(or desc "???")) - (tags . ()) - (dependencies . ,deps) - (modules . ,(pkg-directory->module-paths - dir - pkg-name - #:namespace metadata-ns)))) - (define pkg-file (build-path catalog-path "pkg" pkg-name)) - (define exists? (file-exists? pkg-file)) - (cond - [(and exists? - (equal? (with-handlers ([exn:fail:read? void]) - (call-with-input-file* pkg-file read)) - pkg)) - ;; No change - (void)] - [else - (printf " ~aataloging package ~a\n" - (if exists? "Rec" "C") - pkg-name) - (make-directory* (build-path catalog-path "pkg")) - (call-with-output-file* - pkg-file - #:exists 'truncate/replace - (lambda (o) - (write pkg o) - (newline o)))])) - -(for ([p (in-list missing-desc)]) - (printf "Missing package description for ~a\n" p)) -(for ([p (in-list missing-authors)]) - (printf "Missing package authors for ~a\n" p)) - -(unless (and (null? missing-authors) (null? missing-desc)) - (error 'link-all "not all packages have description and authors."))