make: link packages via local catalog

Change the way that packages in "pkgs" are handled by `make`:
create a catalog that causes them to be installed on demand
as directory links.

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 and installs packages that you specify, or
-   subdirectory. This is the most natural mode for developing Racket
+   "main-distribution" plus "main-distribution-test" by default.  Any
-   itself or staying on the bleeding edge. See "Quick Instructions:
+   package implementations that reside in the "pkgs" subdirectory are
-   In-place Build" below.
+   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
+and 2013/12.0), `nmake win32-in-place' creates a build in the "racket"
-win32-in-place' creates a build in the "racket" directory.  For
+directory. For information on configuring your command-line
-information on configuring your command-line environment for Visual
+environment for Visual Studio, see "racket/src/worksp/README".
-Studio, see "racket/src/worksp/README".
 
-On Windows with MinGW, see the notes below on Git submodules, and then
+On Windows with MinGW, `make PLAIN_RACKET=racket/racket', since MinGW
-`make PLAIN_RACkET=racket/racket', since MinGW uses Unix-style tools
+uses Unix-style tools but generates a Windows-layout Racket build.
-but generates a Windows-layout Racket build.
 
-In all cases, an in-place build includes (via links) packages that are
+In all cases, an in-place build includes (via links) a few packages
-in the "pkgs" directory.
+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=<dir>' builds and installs into <dir>
 with binaries in "<dir>/bin", packages in "<dir>/share/racket/pkgs",
 documentation in "<dir>/share/racket/doc", etc.
 
-On Mac OS X, see the notes below on Git submodules, and then `make
+On Mac OS X, `make unix-style PREFIX=<dir>' builds and installs into
-unix-style PREFIX=<dir>' builds and installs into "<dir>" with
+"<dir>" with binaries in "<dir>/bin", packges in "<dir>/share/pkgs",
-binaries in "<dir>/bin", packges in "<dir>/share/pkgs", documentation
+documentation in "<dir>/doc", etc.
-in "<dir>/doc", etc.
 
 On Windows, Unix-style install is not supported.
 
@@ -95,26 +97,6 @@ assembles the installation in "<dest-dir>". 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
+The "pkgs" directory contains packages that are tied to the Racket
-Racket distribution, plus some additional packages (such as tests).  A
+core implementation and are therefore kept in the same Git
-`make in-place' links to the package in-place, while `make unix-style'
+repository. A `make in-place' links to the package in-place, while
-copies packages out of "pkgs" to install them.
+`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.
 
 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
+dependencies. The default value of `PKGS' is "main-distribution
-"pkgs" among its dependencies. See "Linking Packages for In-place
+main-distribution-test". If you run `make` a second time, all
-Development Mode", below, for more information on package links and
+previously installed packages remain installed, while new packages are
-using `again' or `LINK_MODE' to use remembered `PKGS' values from
+added. To uninstall previously selected package, use `raco pkg`.
-previous `make in-place's. Setting `PKGS' also works for `make
-unix-style'.
 
 Using `make' (or `make in-place') sets the installation's name to
 "development", unless the installation has been previously configured

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
+PKGS = main-distribution main-distribution-test
-LINK_PKGS = $(PKGS) racket-doc at-exp-lib racket-test racket-benchmarks racket-index
-INSTALL_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)
+	$(MAKE) pkgs-catalog
-	$(PLAIN_RACKET) $(LIBSETUP) $(JOB_OPTIONS) $(PLT_SETUP_OPTIONS)
+	$(PLAIN_RACO) pkg install $(INSTALL_PKGS_ARGS)
-	$(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)
 
 # 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 \
+	$(WIN32_PLAIN_RACO) pkg install $(INSTALL_PKGS_ARGS)
-	 --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)
-
 
 # ------------------------------------------------------------
 # 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:
+pkgs-catalog:
-	$(PLAIN_RACKET) $(LINK_ALL) $(LINK_MODE) $(PKGS) $(REQUIRED_PKGS)
+	$(PLAIN_RACKET) $(PKGS_CATALOG)
 
-pkg-extra-links:
+win32-pkgs-catalog:
-	$(PLAIN_RACKET) $(LINK_ALL) $(LINK_MODE) $(LINK_PKGS) $(REQUIRED_PKGS)
+	$(MAKE) pkg-links PLAIN_RACKET="$(WIN32_PLAIN_RACKET)"
-
-win32-pkg-links:
-	$(MAKE) pkg-links PLAIN_RACKET="$(WIN32_PLAIN_RACKET)" LINK_MODE="$(LINK_MODE)" PKGS="$(PKGS)"
 
 # ------------------------------------------------------------
 # On a server platform (for an installer build):

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?)))]{

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

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)
+                           (cond
-                               (get-default)
+                            [(not i) (get-default)]
-                               (list i))))
+                            [(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])]))
 

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))

racket/src/link-all.rkt

@@ -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 <dir>"
-    (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)
-                                                          (string<? a b))]
-                                                    [(is-auto? b) #t]
-                                                    [else (string<? a b)]))))])
-                   (define dir (hash-ref found name))
-                   (define auto? (is-auto? name))
-                   (printf "Adding ~a~a as ~a\n" name (if auto? "*" "") dir)
-                   (pkg-desc (path->string 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))))

racket/src/pack-all.rkt

@@ -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 <dest-dir>"
-    (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 <dir>/<checksum>"
-    (set! checksum-dir dir)]
-   [("--mods") "Include modules and dependencies in catalog"
-    (set! get-modules? #t)]
-   #:multi
-   [("++catalog") catalog-dir "Write catalog entry to <catalog-dir>"
-    (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)]))))

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))))