diff --git a/INSTALL.txt b/INSTALL.txt index e6b2b6668b..f2478393bd 100644 --- a/INSTALL.txt +++ b/INSTALL.txt @@ -20,13 +20,19 @@ distributions will work in the way that you probably expect. +>>>> SORRY! Some of the information in this file is out of date, +>>>> and probably only in-place installation works at the moment. +>>>> Build modes and information here are being updated. + If you stick with this repository, then you have several options: * In-place build --- the default, creates a build in the "racket" - subdirectory that references the packages that reside in the "pkgs" - subdirectory. This is the most natural mode for developing Racket - itself or staying on the bleeding edge. See "Quick Instructions: - In-place Build" below. + subdirectory and installs packages that you specify, or + "main-distribution" plus "main-distribution-test" by default. Any + package implementations that reside in the "pkgs" subdirectory are + linked in place. This is the most natural mode for developing + Racket itself or staying on the bleeding edge. See "Quick + Instructions: In-place Build" below. * Unix-style install --- installs to a given destination directory (Unix and Mac OS X, only), leaving no reference to the source @@ -52,21 +58,18 @@ Quick Instructions: In-place Build On Unix, `make' (or `make in-place') creates a build in the "racket" directory. -On Mac OS X, see the notes below on Git submodules, and then `make' -(or `make in-place') creates a build in the "racket" directory. - On Windows with Microsoft Visual Studio (any version between 2008/9.0 -and 2013/12.0), see the notes below on Git submodules, and then `nmake -win32-in-place' creates a build in the "racket" directory. For -information on configuring your command-line environment for Visual -Studio, see "racket/src/worksp/README". +and 2013/12.0), `nmake win32-in-place' creates a build in the "racket" +directory. For information on configuring your command-line +environment for Visual Studio, see "racket/src/worksp/README". -On Windows with MinGW, see the notes below on Git submodules, and then -`make PLAIN_RACkET=racket/racket', since MinGW uses Unix-style tools -but generates a Windows-layout Racket build. +On Windows with MinGW, `make PLAIN_RACKET=racket/racket', since MinGW +uses Unix-style tools but generates a Windows-layout Racket build. -In all cases, an in-place build includes (via links) packages that are -in the "pkgs" directory. +In all cases, an in-place build includes (via links) a few packages +that are in the "pkgs" directory. To get new versions of those +packages, as well as the Racket core, then use `git pull`. To get +new versions of any other package, use `raco pkg update`. See "More Instructions: Building Racket" below for more information. @@ -78,10 +81,9 @@ On Unix, `make unix-style PREFIX=' builds and installs into with binaries in "/bin", packages in "/share/racket/pkgs", documentation in "/share/racket/doc", etc. -On Mac OS X, see the notes below on Git submodules, and then `make -unix-style PREFIX=' builds and installs into "" with -binaries in "/bin", packges in "/share/pkgs", documentation -in "/doc", etc. +On Mac OS X, `make unix-style PREFIX=' builds and installs into +"" with binaries in "/bin", packges in "/share/pkgs", +documentation in "/doc", etc. On Windows, Unix-style install is not supported. @@ -95,26 +97,6 @@ assembles the installation in "". Then, copy the content of See "More Instructions: Building Racket" below for more information. -Git Submodules (Mac OS X and Windows) -===================================== - -On Mac OS X and Windows, you'll need native-library packages in the -"native-pkgs" directory for either an in-place build or a Unix-style -install. The "native-pkgs" directory is treated in the same way as -"pkgs"; for example, in-place build uses links into the "native-pkgs" -directory. - -The "native-pkgs" directory is a Git submodule, so you'll need - - git submodule init - git submodule update - -before you do anything else. - -The "native-pkgs" directory is also needed if you build for 64-bit -Linux with the `--enable-natipkg` option to `configure`. - - More Instructions: Building Racket ================================== @@ -130,13 +112,10 @@ unix-style'. (The `_qq' suffix on the variable name is a convention that indicates that single- and double-quote marks are allowed in the value.) -The "pkgs" directory contains the packages that are included in a -Racket distribution, plus some additional packages (such as tests). A -`make in-place' links to the package in-place, while `make unix-style' -copies packages out of "pkgs" to install them. - -Either way, if you're building on Mac OS X or Windows, be sure to -start with "Git Submodules", above. +The "pkgs" directory contains packages that are tied to the Racket +core implementation and are therefore kept in the same Git +repository. A `make in-place' links to the package in-place, while +`make unix-style' copies packages out of "pkgs" to install them. To install a subset of the packages in "pkgs", supply `PKGS' value to `make'. For example, @@ -144,12 +123,10 @@ To install a subset of the packages in "pkgs", supply `PKGS' value to make PKGS="gui-lib readline-lib" links only the "gui-lib" and "readline-lib" packages and their -dependencies. The default value of `PKGS' reaches all packages in -"pkgs" among its dependencies. See "Linking Packages for In-place -Development Mode", below, for more information on package links and -using `again' or `LINK_MODE' to use remembered `PKGS' values from -previous `make in-place's. Setting `PKGS' also works for `make -unix-style'. +dependencies. The default value of `PKGS' is "main-distribution +main-distribution-test". If you run `make` a second time, all +previously installed packages remain installed, while new packages are +added. To uninstall previously selected package, use `raco pkg`. Using `make' (or `make in-place') sets the installation's name to "development", unless the installation has been previously configured diff --git a/Makefile b/Makefile index 8cbf3e4392..335da76178 100644 --- a/Makefile +++ b/Makefile @@ -21,9 +21,7 @@ # Packages (separated by spaces) to link in development mode or # to include in a distribution: -PKGS = base racket-lib # plt-services -LINK_PKGS = $(PKGS) racket-doc at-exp-lib racket-test racket-benchmarks racket-index -INSTALL_PKGS = main-distribution main-distribution-test +PKGS = main-distribution main-distribution-test # ------------------------------------------------------------ # In-place build @@ -38,8 +36,6 @@ WIN32_PLAIN_RACO = racket\racket -N raco -l- raco MACOSX_CHECK_ARGS = -I racket/base -e '(case (system-type) [(macosx) (exit 0)] [else (exit 1)])' MACOSX_CHECK = $(PLAIN_RACKET) -G build/config $(MACOSX_CHECK_ARGS) -LINK_MODE = --save - CPUS = in-place: @@ -51,17 +47,16 @@ cpus-in-place: $(MAKE) -j $(CPUS) plain-in-place JOB_OPTIONS="-j $(CPUS)" PKGS="$(PKGS)" # Explicitly propagate variables for non-GNU `make's: -PKG_LINK_COPY_ARGS = PKGS="$(PKGS)" LINK_MODE="$(LINK_MODE)" -PKG_LINK_COPY_EXTRA_ARGS = PKGS="$(LINK_PKGS)" LINK_MODE="$(LINK_MODE)" LIBSETUP = -N raco -l- raco setup +INSTALL_PKGS_ARGS = $(JOB_OPTIONS) \ + --skip-installed --scope installation --deps search-auto \ + $(REQUIRED_PKGS) $(PKGS) + plain-in-place: $(MAKE) base - $(MAKE) pkg-links $(PKG_LINK_COPY_ARGS) - $(PLAIN_RACKET) $(LIBSETUP) $(JOB_OPTIONS) $(PLT_SETUP_OPTIONS) - $(MAKE) pkg-extra-links $(PKG_LINK_COPY_EXTRA_ARGS) # NOTE: no setup after this step - $(PLAIN_RACO) pkg install $(JOB_OPTIONS) --scope installation \ - --deps search-auto $(INSTALL_PKGS) + $(MAKE) pkgs-catalog + $(PLAIN_RACO) pkg install $(INSTALL_PKGS_ARGS) # For Windows: set up the following collections first, so that native # libraries are in place for use by a full setup: @@ -69,20 +64,10 @@ LIB_PRE_COLLECTS = racket db com win32-in-place: $(MAKE) win32-base - $(MAKE) win32-pkg-links $(PKG_LINK_COPY_ARGS) + $(MAKE) win32-pkgs-catalog $(WIN32_PLAIN_RACKET) $(LIBSETUP) -nxiID $(JOB_OPTIONS) $(PLT_SETUP_OPTIONS) $(LIB_PRE_COLLECTS) $(WIN32_PLAIN_RACKET) $(LIBSETUP) $(JOB_OPTIONS) $(PLT_SETUP_OPTIONS) - $(WIN32_PLAIN_RACO) pkg install $(JOB_OPTIONS) --scope installation \ - --deps search-auto $(INSTALL_PKGS) - -again: - $(MAKE) LINK_MODE="--restore" - -IN_PLACE_COPY_ARGS = JOB_OPTIONS="$(JOB_OPTIONS)" PLT_SETUP_OPTIONS="$(PLT_SETUP_OPTIONS)" - -win32-again: - $(MAKE) LINK_MODE="--restore" $(IN_PLACE_COPY_ARGS) - + $(WIN32_PLAIN_RACO) pkg install $(INSTALL_PKGS_ARGS) # ------------------------------------------------------------ # Unix-style build (Unix and Mac OS X, only) @@ -304,16 +289,13 @@ WIN32_BUNDLE_RACO = bundle\racket\racket $(BUNDLE_RACO_FLAGS) # ------------------------------------------------------------ # Linking all packages (development mode; not an installer build) -LINK_ALL = -U -G build/config racket/src/link-all.rkt ++dir pkgs +PKGS_CATALOG = -U -G build/config racket/src/pkgs-catalog.rkt pkgs -pkg-links: - $(PLAIN_RACKET) $(LINK_ALL) $(LINK_MODE) $(PKGS) $(REQUIRED_PKGS) +pkgs-catalog: + $(PLAIN_RACKET) $(PKGS_CATALOG) -pkg-extra-links: - $(PLAIN_RACKET) $(LINK_ALL) $(LINK_MODE) $(LINK_PKGS) $(REQUIRED_PKGS) - -win32-pkg-links: - $(MAKE) pkg-links PLAIN_RACKET="$(WIN32_PLAIN_RACKET)" LINK_MODE="$(LINK_MODE)" PKGS="$(PKGS)" +win32-pkgs-catalog: + $(MAKE) pkg-links PLAIN_RACKET="$(WIN32_PLAIN_RACKET)" # ------------------------------------------------------------ # On a server platform (for an installer build): diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl index 3cb5e143c0..e54d1ebb15 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -568,7 +568,7 @@ The results are as follows: ]} @defproc[(extract-pkg-dependencies [info (symbol? (-> any/c) . -> . any/c)] - [#:build-deps? build-deps? boolean? #f] + [#:build-deps? build-deps? boolean? #t] [#:filter? filter? boolean? #f] [#:versions? versions? boolean? #f]) (listof (or/c string? (cons/c string? list?)))]{ diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/raco/config.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/raco/config.scrbl index d0144e18cb..d1fe91c0ca 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/raco/config.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/raco/config.scrbl @@ -122,7 +122,10 @@ directory}: @item{@indexed-racket['catalogs] --- a list of URL strings used as the search path for resolving package names. An @racket[#f] in the list - is replaced with the default search path.} + is replaced with the default search path. A string that does not + start with alphabetic characters followed by @litchar{://} is + treated as a path, where a relative path is relative to the + configuration directory.} @item{@indexed-racket['default-scope] --- either @racket["user"] or @racket["installation"], determining the default @tech[#:doc diff --git a/racket/collects/pkg/private/config.rkt b/racket/collects/pkg/private/config.rkt index 31ee2ff4c7..07c1a3bdad 100644 --- a/racket/collects/pkg/private/config.rkt +++ b/racket/collects/pkg/private/config.rkt @@ -1,6 +1,7 @@ #lang racket/base (require setup/dirs racket/file + racket/path racket/match racket/format net/url @@ -58,11 +59,21 @@ (match k ['catalogs (if (member #f v) - ;; Replace #f with default URLs: + ;; Replace #f with default URLs, relative path + ;; with absolute path: (apply append (for/list ([i (in-list v)]) - (if (not i) - (get-default) - (list i)))) + (cond + [(not i) (get-default)] + [(regexp-match? #rx"^[a-z]+://" i) + (list i)] + [else + ;; If it doesn't look like a URL, then treat it as + ;; a path (potentially relative to the configuration file): + (list + (url->string + (path->url + (simple-form-path + (path->complete-path i (path->complete-path (pkg-dir #t)))))))]))) v)] [_ v])])) diff --git a/racket/collects/pkg/private/install.rkt b/racket/collects/pkg/private/install.rkt index acfed80a84..dfe800caa4 100644 --- a/racket/collects/pkg/private/install.rkt +++ b/racket/collects/pkg/private/install.rkt @@ -942,7 +942,7 @@ (pkg-desc-source pkg-name) (pkg-desc-checksum pkg-name) new-checksum))) - + (if (or (not (equal? (pkg-info-checksum info) new-checksum)) ;; No checksum available => always update @@ -980,7 +980,7 @@ #:link-dirs? link-dirs?) name) null))] - [(eq? #t (hash-ref update-cache pkg-name #f)) + [(hash-ref update-cache pkg-name #f) ;; package is already being updated null] ;; A string indicates that package source that should be @@ -1012,6 +1012,10 @@ pkg-name)) null)) + (define (skip/update-dependencies) + (hash-set! update-cache pkg-name #t) + (update-dependencies)) + (match orig-pkg [`(,(or 'link 'static-link) ,orig-pkg-dir) (if must-update? @@ -1022,7 +1026,7 @@ pkg-name (simple-form-path (path->complete-path orig-pkg-dir (pkg-installed-dir)))) - (update-dependencies))] + (skip/update-dependencies))] [`(dir ,_) (if must-update? (pkg-error (~a "cannot update packages installed locally;\n" @@ -1030,7 +1034,7 @@ " package was installed via a local directory\n" " package name: ~a") pkg-name) - (update-dependencies))] + (skip/update-dependencies))] [`(file ,_) (if must-update? (pkg-error (~a "cannot update packages installed locally;\n" @@ -1038,7 +1042,7 @@ " package was installed via a local file\n" " package name: ~a") pkg-name) - (update-dependencies))] + (skip/update-dependencies))] [_ (define-values (orig-pkg-source orig-pkg-type orig-pkg-dir) (if (eq? 'clone (car orig-pkg)) diff --git a/racket/src/link-all.rkt b/racket/src/link-all.rkt deleted file mode 100644 index 32688f3ffc..0000000000 --- a/racket/src/link-all.rkt +++ /dev/null @@ -1,280 +0,0 @@ -#lang racket/base -(require racket/cmdline - racket/file - racket/list - racket/format - racket/string - racket/set - racket/path - setup/getinfo - pkg/lib - pkg/path) - -;; Find packages in a directory tree ("info.rkt" indicates a package) -;; and link the packages into an installation. The packages are linked -;; in a "devel-pkgs" scope to isolate them from packages at -;; "installation" scope, so that the set of linked packages can be -;; updated when the directory content changes. - -;; Used by the top-level Makefile in the main Racket repository. - -(define config-dir-path (build-path "racket" "etc")) -(define config-file-path (build-path config-dir-path "config.rktd")) -(define devel-pkgs-rel-dir (build-path "devel-pkgs")) -(define devel-pkgs-dir (build-path "racket" "share" devel-pkgs-rel-dir)) -(define cache-file-path (build-path "racket" "share" "info-cache.rktd")) - -(define only-platform? #f) -(define save? #f) -(define restore? #f) - -(define dirs null) - -(define cmdline-pkgs - (command-line - #:once-each - [("--platform") "Only packages whose names match the platform name" - (set! only-platform? #t)] - #:once-any - [("--save") "Save package choices" - (set! save? #t)] - [("--restore") "Use saved package choices, if any" - (set! restore? #t)] - #:multi - [("++dir") dir "Use packages in " - (set! dirs (cons dir dirs))] - #:args - pkg - (list->set pkg))) - -(define pkgs-choice-path (build-path config-dir-path "link-pkgs.rktd")) - -(define-values (pkgs keeping?) - (if (and restore? - (file-exists? pkgs-choice-path)) - (values - (list->set - (call-with-input-file* pkgs-choice-path read)) - #t) - (values cmdline-pkgs #f))) - -(printf "Linking packages~a:\n" - (if keeping? - (format " (using packages choice from ~a)" pkgs-choice-path) - "")) -(for ([p (in-set pkgs)]) - (printf " ~a\n" p)) -(when save? - (unless keeping? - (printf "Recording packages choice in ~a\n" pkgs-choice-path) - (call-with-output-file* - pkgs-choice-path - #:exists 'truncate/replace - (lambda (o) - (write (set->list pkgs) o) - (newline o))))) - -(define devel-pkgs-bytes - (path->bytes (build-path 'up "share" devel-pkgs-rel-dir))) -(define devel-links-bytes - (path->bytes (build-path 'up "share" devel-pkgs-rel-dir "links.rktd"))) - -(when (file-exists? config-file-path) - (call-with-input-file* - config-file-path - (lambda (i) - (define r (read i)) - (define (check what id bytes alt-path) - (define l (hash-ref r id #f)) - (unless (and (list? l) - (or (member bytes l) - (member (path->bytes (path->complete-path alt-path)) l))) - (error 'link-all - (~a "config file exists, but does not have a definition of `~a' that includes development ~a\n" - " config file: ~a\n" - " development packages: ~s\n" - " possible solution: delete the config file") - id - what - config-file-path - bytes))) - (check "packages" - 'pkgs-search-dirs - devel-pkgs-bytes - devel-pkgs-dir) - (check "links" - 'links-search-files - devel-links-bytes - (build-path devel-pkgs-dir "links.rktd"))))) - -;; found: maps each available package name to a directory -(define found (make-hash)) - -(define rx:platform (regexp - (regexp-quote - (apply - ~a - #:separator "-" - (map path->string - (explode-path (system-library-subpath #f))))))) - -(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")) - (when (or (not only-platform?) - (regexp-match? rx:platform f)) - (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)]))))) - -(define metadata-ns (make-base-namespace)) -(parameterize ([current-namespace metadata-ns]) - ;; with compiled files on: - (dynamic-require '(submod info reader) #f) - (dynamic-require 'info 0)) -(define (get-pkg-info pkg-dir) - ;; without compiled files: - (parameterize ([use-compiled-file-paths '()]) - (get-info/full pkg-dir #:namespace metadata-ns))) - -(define missing-desc null) -(define missing-authors null) - -(define single-collection-pkgs (make-hash)) - -(define all-pkgs - (let loop ([all-pkgs pkgs] [pkgs pkgs]) - (define new-pkgs - (for/fold ([new-pkgs (set)]) ([pkg-name (in-set pkgs)] - #:unless (equal? pkg-name "racket")) - (define dir (hash-ref found pkg-name #f)) - (unless dir - (error 'link-all "requested package not available: ~s" pkg-name)) - (define i (get-pkg-info dir)) - (define sc-name (i 'collection (lambda _ pkg-name))) - (when (string? sc-name) - (hash-set! single-collection-pkgs pkg-name sc-name)) - (define deps - (extract-pkg-dependencies i #:filter? #t)) - (unless (string? (i 'pkg-desc (lambda _ #f))) - (set! missing-desc (cons pkg-name missing-desc))) - (unless (list? (i 'pkg-authors (lambda _ #f))) - (set! missing-authors (cons pkg-name missing-authors))) - (set-union - new-pkgs - (for/set ([dep (in-list deps)] - #:unless (or (set-member? all-pkgs dep) - (set-member? pkgs dep) - (equal? dep "racket"))) - dep)))) - (if (set-empty? new-pkgs) - all-pkgs all-pkgs - #; - (loop (set-union new-pkgs all-pkgs) new-pkgs)))) - -(define (is-auto? name) (not (set-member? pkgs name))) - -;; Exit if we detect no change: -(when (and (null? missing-desc) - (null? missing-authors)) - (with-handlers ([exn:fail? (lambda (exn) - (printf "shortcut failed: ~s" (exn-message exn)))]) - (define devel-pkgs-file (build-path devel-pkgs-dir "pkgs.rktd")) - (define expected-link-results - (for/hash ([name (in-set all-pkgs)]) - (define dir (hash-ref found name)) - (define rel-dir (path->string (find-relative-path (path->complete-path devel-pkgs-dir) - (path->complete-path dir)))) - (define sc-name (hash-ref single-collection-pkgs name #f)) - (define auto? (is-auto? name)) - (values name - (if sc-name - (sc-pkg-info `(static-link ,rel-dir) #f auto? sc-name) - (pkg-info `(static-link ,rel-dir) #f auto?))))) - (when (and (file-exists? devel-pkgs-file) - (equal? (call-with-input-file* devel-pkgs-file read) - expected-link-results)) - (printf "No changes to links\n") - (exit 0)))) - -;; flush old configuration -(when (directory-exists? devel-pkgs-dir) - (printf "Erasing previous development package configuration\n") - (delete-directory/files devel-pkgs-dir)) - -(define orig-info-cache - (and (file-exists? cache-file-path) - (let () - (printf "Saving previous info cache\n") - (begin0 - (call-with-input-file* cache-file-path read) - (delete-file cache-file-path))))) - -(void - (parameterize ([current-pkg-scope (path->complete-path devel-pkgs-dir)]) - (with-pkg-lock - (pkg-install #:dep-behavior 'force - (for/list ([name (in-list (sort (set->list all-pkgs) - ;; Non-auto before auto: - (lambda (a b) - (cond - [(is-auto? a) - (and (is-auto? b) - (stringstring dir) - 'static-link - #f - #f - auto?)))))) - -(when orig-info-cache - (printf "Restoring previous info cache\n") - (call-with-output-file* cache-file-path (lambda (o) - (write orig-info-cache 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.")) - -;; link configuration -(unless (file-exists? config-file-path) - (printf "Writing ~a\n" config-file-path) - (call-with-output-file* - config-file-path - (lambda (o) - (write (hash 'pkgs-search-dirs - (list #f devel-pkgs-bytes) - 'links-search-files - (list #f devel-links-bytes) - 'installation-name - "development" - 'default-scope - "installation") - o) - (newline o)))) diff --git a/racket/src/pack-all.rkt b/racket/src/pack-all.rkt deleted file mode 100644 index 5922ebdfbe..0000000000 --- a/racket/src/pack-all.rkt +++ /dev/null @@ -1,225 +0,0 @@ -#lang racket/base -(require racket/cmdline - racket/file - racket/port - racket/string - racket/list - racket/path - file/zip - openssl/sha1 - net/url - pkg/strip - pkg/lib - setup/getinfo) - -;; Find packages in the same way as "link-all.rkt", but packs -;; them into ".zip" files and adds them to a catalog. - -;; Used by the top-level Makefile in the main Racket repository. - -;; Increment this number if something about the way packages are -;; generated changes, so that previously generated packages are -;; reliably replaced: -(define package-format-version 2) - -(define pack-dest-dir #f) -(define catalog-dirs null) -(define native? #f) -(define relative? #t) -(define get-modules? #f) -(define checksum-dir #f) -(define source-checksums? #f) - -(define src-dirs - (command-line - #:once-each - [("--pack") dest-dir "Pack to " - (set! pack-dest-dir dest-dir)] - [("--native") "Pack as native" - (set! native? #t)] - [("--absolute") "Record paths as absolute" - (set! relative? #f)] - [("--source-checksum") "Compute checksum from source when not packing" - (set! source-checksums? #t)] - [("--at-checksum") dir "Copy each to to /" - (set! checksum-dir dir)] - [("--mods") "Include modules and dependencies in catalog" - (set! get-modules? #t)] - #:multi - [("++catalog") catalog-dir "Write catalog entry to " - (set! catalog-dirs (cons catalog-dir catalog-dirs))] - #:args - pkgs-dir - pkgs-dir)) - -(when pack-dest-dir - (make-directory* pack-dest-dir)) -(for ([catalog-dir (in-list catalog-dirs)]) - (make-directory* catalog-dir)) - -(define metadata-ns (make-base-namespace)) - -(define (status fmt . args) - (apply printf fmt args) - (flush-output)) - -(define (stream-directory d) - (define-values (i o) (make-pipe (* 100 4096))) - (write package-format-version o) - (define (skip-path? p) - (let-values ([(base name dir?) (split-path p)]) - (define s (path->string name)) - (or (member s '("compiled")) - (regexp-match? #rx#"^(?:[.]git.*|[.]svn|.*~|#.*#)$" s)))) - (thread (lambda () - (let loop ([d d]) - (for ([f (directory-list d #:build? #t)]) - (cond - [(skip-path? f) (void)] - [(directory-exists? f) - (write (filter-not skip-path? (directory-list f)) o) - (loop f)] - [(file-exists? f) - (call-with-input-file* - f - (lambda (i) (copy-port i o)))]))) - (close-output-port o))) - i) - -(define (do-package src-dir pkg-name) - (define zip-file (path-add-suffix pkg-name #".zip")) - (define dest-zip (and pack-dest-dir - (build-path (path->complete-path pack-dest-dir) - zip-file))) - - (define pkg-src-dir (build-path src-dir pkg-name)) - - (when pack-dest-dir - (define sum-file (path-add-suffix pkg-name #".srcsum")) - (status "summing ~a\n" pkg-src-dir) - (define src-sha1 (sha1 (stream-directory pkg-src-dir))) - (define dest-sum (build-path (path->complete-path pack-dest-dir) sum-file)) - (unless (and (file-exists? dest-zip) - (file-exists? dest-sum) - (equal? (list (version) src-sha1) - (call-with-input-file* dest-sum read))) - (status "packing ~a\n" zip-file) - (define tmp-dir (make-temporary-file "~a-pkg" 'directory)) - (parameterize ([strip-binary-compile-info #f]) ; for deterministic checksum - (generate-stripped-directory (if native? 'binary 'source) - pkg-src-dir - tmp-dir)) - (parameterize ([current-directory tmp-dir]) - (when (file-exists? dest-zip) (delete-file dest-zip)) - (apply zip dest-zip (directory-list) - ;; Use a constant timestamp so that the checksum does - ;; not depend on timestamps: - #:timestamp 1359788400 - #:utc-timestamps? #t - #:system-type 'unix)) - (delete-directory/files tmp-dir) - (call-with-output-file* - dest-sum - #:exists 'truncate/replace - (lambda (o) - (write (list (version) src-sha1) o) - (newline o))))) - - (define info-path (build-path src-dir pkg-name)) - (define i (get-info/full info-path)) - (define (get key) - (i key (lambda () - (error 'catalog-local - "missing `~a'\n path: ~a" - key - (build-path info-path "info.rkt"))))) - - (define (write-catalog-entry catalog-dir) - (define catalog-dir/normal (simplify-path (path->complete-path catalog-dir))) - (define catalog-pkg-dir (build-path catalog-dir "pkg")) - (define checksum (if dest-zip - (call-with-input-file* dest-zip sha1) - (if source-checksums? - (begin - (status "summing ~a\n" pkg-src-dir) - (sha1 (stream-directory pkg-src-dir))) - "0"))) - (define orig-dest (if dest-zip - (build-path pack-dest-dir zip-file) - #f)) - (define checksum-dest (if checksum-dir - (build-path checksum-dir checksum zip-file) - orig-dest)) - (define pkg-dir (build-path src-dir pkg-name)) - (define info (and get-modules? - (get-info/full pkg-dir - #:namespace metadata-ns - #:bootstrap? #t))) - (when dest-zip - (when checksum-dir - (make-directory* (build-path checksum-dir checksum)) - (copy-file orig-dest checksum-dest #t)) - (call-with-output-file* - (build-path (path-replace-suffix checksum-dest #".zip.CHECKSUM")) - #:exists 'truncate/replace - (lambda (o) - (display checksum o)))) - (make-directory* catalog-pkg-dir) - (call-with-output-file* - (build-path catalog-pkg-dir pkg-name) - #:exists 'truncate - (lambda (o) - (write (hash 'source (path->string - (let ([p (path->complete-path - (if dest-zip - checksum-dest - (path->directory-path pkg-dir)))]) - (if relative? - (find-relative-path catalog-dir/normal - (simplify-path p)) - p))) - 'checksum checksum - 'name (path->string pkg-name) - 'author (string-join (for/list ([r (get 'pkg-authors)]) - (if (symbol? r) - (format "~a@racket-lang.org" r) - r)) - " ") - 'description (get 'pkg-desc) - 'tags '() - 'dependencies (if get-modules? - (append - (info 'deps (lambda () null)) - (info 'build-deps (lambda () null))) - '()) - 'modules (if get-modules? - (pkg-directory->module-paths - pkg-dir - (path->string pkg-name) - #:namespace metadata-ns) - '())) - o) - (newline o)))) - (for ([catalog-dir (in-list catalog-dirs)]) - (write-catalog-entry catalog-dir))) - -(define found (make-hash)) - -;; 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 src-dirs)]) - (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")) - (when (hash-ref found f #f) - (error 'pack-local - "found packages multiple times: ~a and ~a" - (hash-ref found f) - src-f)) - (hash-set! found f src-f) - (do-package src-dir f)] - [(directory-exists? src-f) - (loop src-f)])))) diff --git a/racket/src/pkgs-catalog.rkt b/racket/src/pkgs-catalog.rkt new file mode 100644 index 0000000000..5b4ac194a2 --- /dev/null +++ b/racket/src/pkgs-catalog.rkt @@ -0,0 +1,171 @@ +#lang racket/base +(require racket/cmdline + racket/file + racket/list + racket/format + racket/string + racket/set + racket/path + setup/getinfo + pkg/lib + pkg/path) + +;; Find packages in a directory tree ("info.rkt" indicates a package), +;; create a catalog that points to those packages to be installed as +;; links, and adjust the configuration to consult that catalog first. + +;; Used by the top-level Makefile in the main Racket repository. + +(define config-dir-path (build-path "racket" "etc")) +(define config-file-path (build-path config-dir-path "config.rktd")) +(define catalog-relative-path (build-path 'up "share" "pkgs-catalog")) +(define catalog-relative-path-str (path->string catalog-relative-path)) +(define catalog-path (build-path config-dir-path catalog-relative-path)) + +(define dirs + (command-line + #:args + dir + dir)) + +(when (file-exists? config-file-path) + (call-with-input-file* + config-file-path + (lambda (i) + (define r (read i)) + (define l (hash-ref r 'catalogs #f)) + (unless (and (list? l) + ((length l) . >= . 1) + (equal? (car l) catalog-relative-path-str)) + (error 'pkgs-catalog + (~a "config file exists, but does not have a definition of `catalogs' that starts as expected\n" + " config file: ~a\n" + " expected initial element: ~s\n" + " possible solution: delete the config file") + config-file-path + catalog-relative-path-str))))) + +;; 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)]))))) + +(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)))) + "?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.")) + +(unless (file-exists? config-file-path) + (printf "Writing ~a\n" config-file-path) + (call-with-output-file* + config-file-path + (lambda (o) + (write (hash 'catalogs + (list catalog-relative-path-str #f) + 'installation-name + "development" + 'default-scope + "installation") + o) + (newline o))))