From c7fac6e98e3bc6aed2d94997c10e20dd89b070f3 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 11 Sep 2015 16:20:14 -0600
Subject: [PATCH] raco pkg catalog-archive: add a `--pkg-fail` option

Relevant to #1032
---
 pkgs/racket-doc/pkg/scribblings/pkg.scrbl |  9 +++++++++
 racket/collects/pkg/main.rkt              | 24 ++++++++++++++++++++++-
 2 files changed, 32 insertions(+), 1 deletion(-)

diff --git a/pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-doc/pkg/scribblings/pkg.scrbl
index a44ec11f21..4f58014a23 100644
--- a/pkgs/racket-doc/pkg/scribblings/pkg.scrbl
+++ b/pkgs/racket-doc/pkg/scribblings/pkg.scrbl
@@ -1026,6 +1026,15 @@ for @nonterm{key}.
  @item{@DFlag{version} @nonterm{version} or @Flag{v} @nonterm{version} --- Copies catalog
        results specific to @nonterm{version}
        (for catalogs that make a distinction), instead of the installation's Racket version.}
+  @item{@DFlag{pkg-fail} @nonterm{mode} --- Determines handling of failure for an individual
+       package, such as when a @nonterm{src-catalog} contains a bad package source. The
+       following @nonterm{mode}s are available:
+       @itemlist[
+         @item{@exec{fail} (the default) --- archiving stops and fails;}
+         @item{@exec{skip} --- the package is skipped and omitted from the archive catalog; or}
+         @item{@exec{continue} --- like @exec{skip}, but @exec{raco pkg catalog-archive}
+               exits with a status code of @exec{5} if any package was skipped.}
+       ]}
  ]
 
  @history[#:added "6.0.17"]
diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt
index 80de6f299c..a658d357c6 100644
--- a/racket/collects/pkg/main.rkt
+++ b/racket/collects/pkg/main.rkt
@@ -581,15 +581,37 @@
              [(#:str state-database #f) state () "Read/write <state-database> as state of <dest-dir>"]
              [(#:str vers #f) version ("-v") "Copy information suitable for Racket <vers>"]
              [#:bool relative () "Make source paths relative when possible"]
+             [(#:sym mode [fail ignore continue] 'fail) pkg-fail () 
+              ("Select handling of package-download failure;"
+               "<mode>s: fail (the default), skip, continue (but with exit status of 5)")]
              #:args (dest-dir . src-catalog)
              (parameterize ([current-pkg-error (pkg-error 'catalog-archive)]
                             [current-pkg-lookup-version (or version
                                                             (current-pkg-lookup-version))])
+                 (define fail-at-end? #f)
                  (pkg-catalog-archive dest-dir
                                       src-catalog
                                       #:from-config? from-config
                                       #:state-catalog state
-                                      #:relative-sources? relative))]
+                                      #:relative-sources? relative
+                                      #:package-exn-handler (case pkg-fail
+                                                              [(fail) (lambda (name exn) (raise exn))]
+                                                              [(skip continue)
+                                                               (lambda (name exn)
+                                                                 (log-error (~a "archiving failed for package; ~a\n"
+                                                                                "  package name: ~a\n"
+                                                                                "  original error:\n~a")
+                                                                            (if (eq? pkg-fail 'continue)
+                                                                                "continuing"
+                                                                                "skipping")
+                                                                            name
+                                                                            (regexp-replace* #rx"(?m:^)"
+                                                                                             (exn-message exn)
+                                                                                             "   "))
+                                                                 (when (eq? pkg-fail 'continue)
+                                                                   (set! fail-at-end? #t)))]))
+                 (when fail-at-end?
+                   (exit 5)))]
             ;; ----------------------------------------
             [archive
              "Create catalog from installed packages"