From 9f239c8b080c1a199970f7da262393ad37c1dbcd Mon Sep 17 00:00:00 2001
From: felix <felix@call-with-current-continuation.org>
Date: Fri, 21 Oct 2022 12:57:22 +0200
Subject: [PATCH] Handle errors while reading egg-info files in a more graceful
 manner

See also #1800

Signed-off-by: felix <felix@call-with-current-continuation.org>
---
 chicken-install.scm   |  5 +++--
 chicken-status.scm    | 17 ++++++++++-------
 chicken-uninstall.scm | 19 ++++++++++---------
 egg-information.scm   |  9 +++++++--
 4 files changed, 30 insertions(+), 20 deletions(-)

diff --git a/chicken-install.scm b/chicken-install.scm
index 524cf0a1..9953f110 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -47,6 +47,7 @@
 (import (chicken sort))
 (import (chicken time))
 (import (chicken pathname))
+(import (chicken condition))
 (import (chicken process))
 (import (chicken process-context))
 (import (chicken pretty-print))
@@ -570,8 +571,8 @@
             ((string=? egg (pathname-file (car eggs)))
              (loop (cdr eggs) same))
             (else
-              (let* ((info (load-egg-info (car eggs)))
-                     (files (assq 'installed-files info))
+              (let* ((info (load-egg-info (car eggs) #t))
+                     (files (and info (assq 'installed-files info)))
                      (mfiles (and files
                                   (filter (lambda (fname)
                                             (and (not (member fname same))
diff --git a/chicken-status.scm b/chicken-status.scm
index 6cbd02bc..5094a10e 100644
--- a/chicken-status.scm
+++ b/chicken-status.scm
@@ -71,7 +71,7 @@
 
   (define (read-info egg #!optional (dir (repo-path)) (ext +egg-info-extension+))
     (let ((f (chicken.load#find-file (make-pathname #f egg ext) dir)))
-      (and f (load-egg-info f))))
+      (and f (load-egg-info f #t))))
 
   (define (filter-egg-names eggs patterns mtch)
     (let* ((names (cond ((null? patterns) eggs)
@@ -151,8 +151,8 @@
       (for-each
         (lambda (egg)
           (let* ((info (read-info egg))
-                 (version (get-egg-property info 'version))
-                 (comps (get-egg-property* info 'components)))
+                 (version (and info (get-egg-property info 'version)))
+                 (comps (and info (get-egg-property* info 'components))))
             (if version
                 (print (format-string (string-append egg " ") w #f #\.)
                        (format-string (string-append " version: "
@@ -178,16 +178,19 @@
      (sort
       (append-map
        (lambda (egg)
-	 (get-egg-property* (read-info egg) 'installed-files))
+         (let ((info (read-info egg)))
+           (when info (get-egg-property* info 'installed-files))))
        eggs)
       string<?)))
 
   (define (dump-installed-versions eggs)
     (for-each
      (lambda (egg)
-       (let ((version (get-egg-property (read-info egg) 'version)))
-	 (pp (cons (string->symbol egg)
-                   (if version (list version) '())))))
+       (let ((info (read-info egg)))
+         (when info
+           (let ((version (get-egg-property info 'version)))
+             (pp (cons (string->symbol egg)
+                       (if version (list version) '())))))))
      eggs))
 
   (define (usage code)
diff --git a/chicken-uninstall.scm b/chicken-uninstall.scm
index 1008b6ac..ac907735 100644
--- a/chicken-uninstall.scm
+++ b/chicken-uninstall.scm
@@ -37,6 +37,7 @@
           (chicken port)
           (chicken pathname)
           (chicken platform)
+          (chicken condition)
           (chicken process)
           (chicken process-context)
           (chicken string))
@@ -104,15 +105,15 @@
   (list->string (reverse (left (reverse (left (string->list str)))))))
  
 (define (remove-extension egg)
-  (and-let* ((ifile (file-exists?
-                      (make-pathname (repo-path) egg +egg-info-extension+)))
-             (files (get-egg-property* (load-egg-info ifile)
-                                       'installed-files)))
-       (for-each
-         (lambda (f)
-           (when (file-exists? f) (delete-installed-file f)))
-         files)
-       (delete-installed-file ifile)))
+  (and-let* ((ifile (file-exists? (make-pathname (repo-path) egg +egg-info-extension+))))
+       (let ((info (load-egg-info ifile #t)))
+         (when info
+           (let ((files (get-egg-property* info 'installed-files)))
+             (for-each
+               (lambda (f)
+                 (when (file-exists? f) (delete-installed-file f)))
+               files)))
+         (delete-installed-file ifile))))
 
 (define (delete-installed-file fname)
   (cond ((not (file-exists? fname))
diff --git a/egg-information.scm b/egg-information.scm
index 6f5f7cb9..3cf46d4f 100644
--- a/egg-information.scm
+++ b/egg-information.scm
@@ -33,9 +33,14 @@
                                (pathname-extension fname))))
     (if (file-exists? fname*) fname* fname)))
 
-(define (load-egg-info fname)
+(define (load-egg-info fname #!optional ignore)
   (let ((fname (locate-egg-file fname)))
-    (with-input-from-file fname read)))
+    (handle-exceptions ex
+      (cond (ignore
+              (warning "error while reading egg-information file - ignored" fname)
+              #f)
+            (else (error "error while reading egg-information file" fname)))
+      (with-input-from-file fname read))))
 
 
 ;;; lookup specific toplevel properties of egg-information
-- 
2.28.0