diff --git a/collects/planet/private/planet-shared.ss b/collects/planet/private/planet-shared.ss index d63d50e495..6fdd881c8e 100644 --- a/collects/planet/private/planet-shared.ss +++ b/collects/planet/private/planet-shared.ss @@ -497,6 +497,8 @@ Various common pieces of code that both the client and server need to access (apply fprintf (current-output-port) str fmt) (newline (current-output-port))))))) + ;; note that this function assumes that 'f' prints line-by-line + ;; output, so that it can be easily logged. (define (with-logging logfile f) (let-values ([(in out) (make-pipe)]) (thread @@ -515,9 +517,10 @@ Various common pieces of code that both the client and server need to access (when outport (display l outport)) (planet-log l) (loop)])))))) - (parameterize ([current-output-port out]) - (f)))) - + (begin0 + (parameterize ([current-output-port out]) + (f)) + (close-output-port out)))) ;; pkg->info : PKG -> (symbol (-> TST) -> TST) ;; get an info.ss thunk for the given package diff --git a/collects/planet/util.ss b/collects/planet/util.ss index e53dc52ec6..d94e7970ee 100644 --- a/collects/planet/util.ss +++ b/collects/planet/util.ss @@ -118,8 +118,11 @@ (lambda () (printf "\n============= Removing ~a =============\n" (list owner name maj min)) (clean-planet-package path (list owner name '() maj min)))) + (planet-log "Erasing metadata") (erase-metadata p) + (planet-log "Deleting files in ~a" (path->string path)) (delete-directory/files path) + (planet-log "Trimming empty directories") (trim-directory (CACHE-DIR) path) (void)))) @@ -219,8 +222,8 @@ (define (directory-empty? dir) (null? (directory-list dir))) -;; trim-directory path path -> void -;; deletes nonempty directories starting with stem and working down to root +;; trim-directory: path path -> void +;; deletes empty directories starting with stem and working down to root (define (trim-directory root stem) (let* ([rootl (explode-path root)] [steml (explode-path stem)]