diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/apis.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/apis.scrbl
index 8aa16e3c2d..005bd3d0c2 100644
--- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/apis.scrbl
+++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/apis.scrbl
@@ -41,8 +41,9 @@ to the @exec{raco pkg} sub-subcommands.
 @defthing[pkg-catalog-show-command procedure?]{Implements @command-ref{catalog-show}.}
 @defthing[pkg-catalog-copy-command procedure?]{Implements @command-ref{catalog-copy}.}
 @defthing[pkg-catalog-archive-command procedure?]{Implements @command-ref{catalog-archive}.
-
                                                   @history[#:added "6.0.17"]}
+@defthing[pkg-archive-command procedure?]{Implements @command-ref{archive}.
+                                                  @history[#:added "6.1.0.8"]}
 
 @include-section["lib.scrbl"]
 @include-section["path.scrbl"]
diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl
index 6f6b1617b2..c5ede680a5 100644
--- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl
+++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl
@@ -397,6 +397,26 @@ for extracting existing catalog information.
 @history[#:added "6.0.1.7"
          #:changed "6.0.1.13" @elem{Added the @racket[#:package-exn-handler] argument.}]}
 
+@defproc[(pkg-archive-pkgs [dest-dir path-string?]
+                           [pkgs (listof path-string?)]
+                           [#:include-deps? include-deps? boolean? #f]
+                           [#:exclude exclude (listof string?) null]
+                           [#:relative-sources? relative-sources? boolean? #f]
+                           [#:quiet? quiet? boolean? #f]
+                           [#:package-exn-handler package-exn-handler (string? exn:fail? . -> . any) (lambda (_pkg-name _exn) (raise _exn))])
+         void?]{
+
+Implements @racket[pkg-archive-command].
+
+The @racket[package-exn-handler] argument handles any exception that
+is raised while trying to archive an individual package; the first
+argument is the package name, and the second is the exception. The
+default re-@racket[raise]s the exception, which aborts the archiving
+process, while a function that logs the exception message and returns
+would allow archiving to continue for other packages.
+
+@history[#:added "6.1.0.8"]}
+
 
 @defproc[(pkg-catalog-update-local [#:catalogs catalogs (listof string?) (pkg-config-catalogs)]
                                    [#:catalog-file catalog-file path-string? (current-pkg-catalog-file)]
diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl
index b5039a0a15..69de5231b0 100644
--- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl
+++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl
@@ -749,6 +749,31 @@ for @nonterm{key}.
  @history[#:added "6.0.17"]
 }
 
+@subcommand{@command/toc{archive} @nonterm{option} ... @nonterm{dest-dir} @nonterm{pkg} ...
+--- Copies information from installed packages named by @nonterm{pkgs}s
+    to a @filepath{catalog} directory catalog in @nonterm{dest-dir}, and also copies
+    all package sources to a @filepath{pkgs} directory in @nonterm{dest-dir}.
+
+    Packages sources are copied and repacked as needed, so that
+    all packages are written to the @filepath{pkgs} directory as
+    @filepath{.zip} archives. This conversion may change the checksum
+    on each archived package.
+
+    The @exec{archive} sub-command accepts
+    the following @nonterm{option}s:
+
+ @itemlist[
+ @item{@DFlag{include-deps} --- Includes the dependencies of the specified packages
+        in the resulting catalog.}
+ @item{@DFlag{exclude} @nonterm{pkg} --- Omits the specified @nonterm{pkg} from the
+        resulting catalog. This also causes the dependencies of @nonterm{pkg} to be
+        omitted if @DFlag{include-deps} is specified. This flag can be provided multiple times.}
+ @item{@DFlag{relative} --- Write package sources to @nonterm{dest-catalog} in relative-path form.}
+ ]
+
+ @history[#:added "6.1.0.8"]
+}
+
 @; ----------------------------------------
 
 @section[#:tag "metadata"]{Package Metadata}
diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalogs.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalogs.rkt
index 9b44c815de..040f6c4a2e 100644
--- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalogs.rkt
+++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-catalogs.rkt
@@ -84,8 +84,10 @@
                                              123)))
                  o))))
      (add-whale! "345")
-     $ (~a "raco pkg catalog-show --catalog file://" (path->string dir2) " whale") =stdout> #rx"Checksum: 345"
-     $ (~a "raco pkg catalog-show --version 5.3.6 --catalog file://" (path->string dir2) " whale") =stdout> #rx"Checksum: 123"
+     $ (~a "raco pkg catalog-show --catalog file://" (path->string dir2) " whale")
+     =stdout> #rx"Checksum: 345"
+     $ (~a "raco pkg catalog-show --version 5.3.6 --catalog file://" (path->string dir2) " whale")
+     =stdout> #rx"Checksum: 123"
      $ "raco pkg catalog-show whale" =exit> 1
      
      $ (~a "raco pkg catalog-copy --merge " (path->string dir2) " " (path->string dest))
@@ -155,4 +157,30 @@
   $ (~a "test -f " archive-d "/pkgs/pkg-test2-snd.zip") =exit> 1
   $ (~a "test -f " archive-d "/pkgs/pkg-test2-snd.zip.CHECKSUM") =exit> 1
   
+  ;; archive
+
+  (delete-directory/files archive-d)
+
+  $ (~a "raco pkg install pkg-test1")
+  $ (~a "raco pkg archive " archive-d " pkg-test1")
+  =stdout> #rx"== Archiving pkg-test1 =="
+  $ (~a "test -f " archive-d "/pkgs/pkg-test1.zip")
+  $ (~a "test -f " archive-d "/pkgs/pkg-test1.zip.CHECKSUM")
+
+
+  $ "raco pkg install pkg-test2"
+  $ (~a "raco pkg archive " archive-d " pkg-test2")
+  =stdout> #rx"removing .* pkg-test1"
+  $ (~a "test -f " archive-d "/pkgs/pkg-test2.zip")
+  $ (~a "test -f " archive-d "/pkgs/pkg-test2.zip.CHECKSUM")
+
+  (delete-directory/files archive-d)
+
+  $ (~a "raco pkg archive --include-deps " archive-d " pkg-test2")
+  =stdout> #rx"Archiving pkg-test1" ;; checking dependencies
+  $ (~a "test -f " archive-d "/pkgs/pkg-test1.zip")
+  $ (~a "test -f " archive-d "/pkgs/pkg-test1.zip.CHECKSUM")
+  $ (~a "test -f " archive-d "/pkgs/pkg-test2.zip")
+  $ (~a "test -f " archive-d "/pkgs/pkg-test2.zip.CHECKSUM")
+
   (delete-directory/files d)))
diff --git a/racket/collects/pkg/commands.rkt b/racket/collects/pkg/commands.rkt
index d4c137fe06..566ade1a53 100644
--- a/racket/collects/pkg/commands.rkt
+++ b/racket/collects/pkg/commands.rkt
@@ -59,7 +59,7 @@
 
   (define-syntax-class option
     #:attributes (command-line variable (param 1) (call 1))
-    [pattern (k:kind arg:id (alias:str ...) doc:expr)
+    [pattern (k:kind arg:id (alias:str ...) doc:expr body:expr ...)
              #:do
              [(define arg-kw (symbol->keyword (syntax->datum #'arg)))
               (define arg-str (format "--~a" (syntax->datum #'arg)))
@@ -80,7 +80,8 @@
                [(alias ... #,arg-str)
                 k.arg-val ...
                 doc
-                (set! #,arg-var (k.fun k.arg-val ...))])])
+                (set! #,arg-var (k.fun k.arg-val ...))
+                body ...])])
 
   (define-syntax-class group-kind
     [pattern #:once-any]
@@ -127,8 +128,10 @@
                    help-strs:expr)])
 
   (define-syntax-class command
-    #:attributes (name function variables command-line)
-    [pattern (name:id doc:expr uh:usage-help ... og:option-group ... arg:arguments)
+    #:attributes (name function variables command-line (extra-defs 1))
+    #:literals (define)
+    [pattern (name:id  doc:expr (~and extra-defs (define x e)) ...
+                       uh:usage-help ... og:option-group ... arg:arguments)
              #:do
              [(define name-str (symbol->string (syntax->datum #'name)))]
              #:attr function
@@ -172,6 +175,7 @@
                          (syntax->list #'(c.name ...)))])
      (syntax/loc stx
        (begin
+         c.extra-defs ... ...
          c.function ...
          (provide (rename-out export-names ...))
          (module+ main
diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt
index 8d6a0ccda7..f8c28cace5 100644
--- a/racket/collects/pkg/lib.rkt
+++ b/racket/collects/pkg/lib.rkt
@@ -3668,6 +3668,164 @@
                   (map db:pkg-name (append pkgs more-pkgs)))) 
                 string<?)))
       null))
+
+
+(define (pkg-archive-pkgs dest-dir pkg-names
+                          #:include-deps? [include-deps? #f]
+                          #:exclude [exclude null]
+                          #:relative-sources? [relative-sources? #f]
+                          #:quiet? [quiet? #f]
+                          #:package-exn-handler [package-exn-handler
+                                                         (λ (name exn) (raise exn))])
+  (struct pkg (deps build-deps) #:transparent)
+  (define (extract-pkg p) (if (string? p) p (car p)))
+
+  (define (add-package-from-dir src-f f-name pkgs)
+    (define i (get-info/full src-f))
+    (cond
+      [i
+       (hash-set pkgs f-name (pkg (map extract-pkg (i 'deps (lambda () null)))
+                                  (map extract-pkg (i 'build-deps (lambda () null)))))]
+      [else pkgs]))
+
+  (define unfiltered-pkgs
+    (for/fold ([pkgs (hash)]) ([pkg-scope (in-list (get-all-pkg-scopes))])
+      (define pkg-names (installed-pkg-names #:scope pkg-scope))
+      (parameterize ([current-pkg-scope pkg-scope])
+        (for/fold ([pkgs pkgs]) ([pkg (in-list pkg-names)])
+          (define dir (pkg-directory pkg))
+          (cond [dir (add-package-from-dir dir pkg pkgs)]
+                [else pkgs])))))
+
+  (define exclude+ (list* "base" "racket" exclude))
+
+  (for ([p (in-list pkg-names)])
+    (unless (hash-ref unfiltered-pkgs p #f)
+      (pkg-error "cannot archive package \"~a\" because it is not installed" p)))
+
+  ;; Filter to roots:
+  (define pkgs/deps
+    (cond
+     [(not include-deps?)
+      (for/hash ([(k v) (in-hash unfiltered-pkgs)]
+                 #:when (member k pkg-names))
+        (values k v))]
+     [else
+      (define seen (make-hash))
+      (define (loop pkg)
+        (cond
+          [(member pkg exclude+)  (void)]
+          [(hash-ref seen pkg #f) (void)]
+          [else
+           (define p (hash-ref unfiltered-pkgs pkg #f))
+           (when p
+             (hash-set! seen pkg #t)
+             (for-each loop (pkg-deps p))
+             (for-each loop (pkg-build-deps p)))]))
+      (for-each loop pkg-names)
+      (for/hash ([(k v) (in-hash unfiltered-pkgs)]
+                 #:when (hash-ref seen k #f))
+        (values k v))]))
+
+  (define all-pkg-names (hash-keys pkgs/deps))
+
+  ;; The temporary catalog we'll create, simulating the current install
+  (define temp-catalog-file (make-temporary-file "pkg~a.sqlite"))
+  ;; all the current installed packages
+  (define all-installed-pkgs
+    (for*/hash ([scope (in-list (get-all-pkg-scopes))]
+                [(k v) (in-hash (read-pkgs-db scope))])
+      (values k v)))
+
+  ;; get the pkg descriptions we want
+  (define pkgs
+    (for/hash ([p (in-list all-pkg-names)])
+      (values p
+              (hash-ref all-installed-pkgs p
+                        (λ _ (pkg-error
+                              "cannot archive package \"~a\" because it is not installed" p))))))
+
+  ;; set up temporary catalog with the right packages
+  (parameterize ([db:current-pkg-catalog-file temp-catalog-file])
+    (db:set-catalogs! '("local"))
+    (db:set-pkgs! "local" all-pkg-names))
+
+  ;; Remove any package not in `pkgs`:
+  (define pkgs-dir (build-path dest-dir "pkgs"))
+  (when (directory-exists? pkgs-dir)
+    (define keep-pkgs (list->set all-pkg-names))
+    (for ([f (in-list (directory-list pkgs-dir))])
+      (cond
+       [(regexp-match #rx"^(.*)[.]zip(?:[.]CHECKSUM)?$" f)
+        => (lambda (m)
+             (unless (set-member? keep-pkgs (cadr m))
+               (unless quiet?
+                 (printf/flush "Removing old package file ~a\n" f))
+               (delete-file (build-path pkgs-dir f))))])))
+
+  (define (pkg->deps p)
+    (match-define (pkg deps build-deps) (hash-ref pkgs/deps p))
+    ;; NOTE: This include deps that don't get archived. It's not
+    ;;       obvious which is the right decision but I've gone with
+    ;;       including them since for "base" keeping but not archiving
+    ;;       seems like the right choice.
+    (remove-duplicates (append deps build-deps)))
+
+  ;; Check on each new package:
+  (for ([(name pkg-i) (in-hash pkgs)])
+    (match-define (pkg-info _ checksum _) pkg-i)
+    (with-handlers ([exn:fail? (λ (exn) (package-exn-handler name exn))])
+      (define pkg-file (build-path dest-dir "pkgs" (format "~a.zip" name)))
+      (define pkg-checksum-file (path-replace-suffix pkg-file #".zip.CHECKSUM"))
+      (define pkg-dir (pkg-directory name))
+
+      (unless pkg-dir
+        (pkg-error "no directory found for package \"~a\"" name))
+
+      (unless quiet?
+        (printf/flush "== Archiving ~a ==\nchecksum: ~a\n" name checksum))
+      ;; Download/unpack existing package:
+      (define-values (staged-name staged-dir staged-checksum clean? staged-mods)
+        (pkg-stage
+         (pkg-desc (path->string pkg-dir) 'dir name checksum #f)
+         #:in-place? #f
+         #:use-cache? #t
+         #:quiet? quiet?))
+      (make-directory* (build-path dest-dir "pkgs"))
+      ;; Repack:
+      (pkg-create 'zip
+                  staged-dir
+                  #:pkg-name name
+                  #:dest (build-path dest-dir "pkgs")
+                  #:quiet? quiet?)
+      (when clean? (delete-directory/files staged-dir))
+
+      ;; Record packed result:
+      (define new-checksum (file->string pkg-checksum-file))
+      (parameterize ([db:current-pkg-catalog-file temp-catalog-file])
+        (db:set-pkg! name "local"
+                     ""
+                     (path->string (path->complete-path pkg-file))
+                     new-checksum
+                     "")
+        (db:set-pkg-dependencies! name "local"
+                                  new-checksum
+                                  (pkg->deps name))
+        (db:set-pkg-modules! name "local"
+                             new-checksum
+                             (set->list staged-mods)))))
+
+  (define dest-catalog (build-path dest-dir "catalog"))
+  (unless quiet?
+    (printf/flush "Creating catalog ~a\n" dest-catalog))
+
+
+  (pkg-catalog-copy (list temp-catalog-file)
+                    (build-path dest-dir "catalog")
+                    #:force? #t
+                    #:override? #t
+                    #:relative-sources? relative-sources?)
+  (delete-file temp-catalog-file))
   
 (define dep-behavior/c
   (or/c #f 'fail 'force 'search-ask 'search-auto))
@@ -3803,6 +3961,14 @@
                         #:quiet? boolean?
                         #:package-exn-handler (string? exn:fail? . -> . any))
         void?)]
+  [pkg-archive-pkgs
+   (->* (path-string? (listof string?))
+        (#:include-deps? boolean?
+                         #:exclude (listof string?)
+                         #:relative-sources? boolean?
+                         #:quiet? boolean?
+                         #:package-exn-handler (string? exn:fail? . -> . any))
+        void?)]
   [default-pkg-scope
    (-> package-scope/c)]
   [installed-pkg-names
diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt
index 0a0ee96a54..c714382464 100644
--- a/racket/collects/pkg/main.rkt
+++ b/racket/collects/pkg/main.rkt
@@ -485,7 +485,25 @@
                                       src-catalog
                                       #:from-config? from-config
                                       #:state-catalog state
-                                      #:relative-sources? relative))]))]))
+                                      #:relative-sources? relative))]
+            ;; ----------------------------------------
+            [archive
+             "Create catalog from installed packages"
+             (define exclude-list (make-parameter null))
+             #:once-each
+             [#:bool include-deps () "Include dependencies of specified packages"]
+             #:multi
+             [(#:str pkg #f) exclude () "Exclude <pkg> from new catalog"
+              (exclude-list (cons pkg (exclude-list)))]
+             #:once-each
+             [#:bool relative () "Make source paths relative when possible"]
+             #:args (dest-dir pkg . pkgs)
+             (parameterize ([current-pkg-error (pkg-error 'pkgs-archive)])
+               (pkg-archive-pkgs dest-dir
+                                 (cons pkg pkgs)
+                                 #:include-deps? include-deps
+                                 #:exclude (exclude-list)
+                                 #:relative-sources? relative))]))]))
   (make-commands
    #:scope-flags
    ([(#:sym scope [installation user] #f) scope ()