Track checksum errors

pkgs/plt-services/meta/pkg-index/official/main.rkt

@@ -247,6 +247,8 @@
      (member author (author->list (package-ref info 'author)))]
     [":no-tag:"
      (empty? (package-ref info 'tags))]
+    [":error:"
+     (hash-ref info 'checksum-error #f)]
     [(regexp #rx"^!(.*?)$" (list _ sub))
      (not (search-term-eval pkg-name info sub))]
     [_
@@ -348,7 +350,9 @@
                     ,t)
                  " "))
       (a ([href ,(main-url page/search (snoc terms ":no-tag:"))])
-         ":no-tag:")))
+         ":no-tag:")
+      (a ([href ,(main-url page/search (snoc terms ":error:"))])
+         ":error:")))
 
 (define (page/search req terms)
   (define pkgs (package-list/search terms))
@@ -810,6 +814,11 @@
          (tr
           (td "Checksum")
           (td ,(package-ref* i 'checksum "")))
+         ,@(if (package-ref* i 'checksum-error #f)
+             `(tr (td "Error")
+                  (td "The last time we attempted to update this checksum. The following error was thrown:"
+                      (pre ,(package-ref* i 'checksum-error ""))))
+             empty)
          (tr
           (td "Last Update")
           (td ,(format-time (package-ref* i 'last-updated #f))))
@@ -895,44 +904,53 @@
   (for-each (curry update-checksum force?) pkgs))
 
 (define (update-checksum force? pkg-name)
-  (define i (package-info pkg-name))
+  (with-handlers
-  (define old-checksum
+      ([exn:fail?
-    (package-ref i 'checksum))
+        (λ (x)
-  (define now (current-seconds))
+          (define i (package-info pkg-name))
-  (define last (hash-ref i 'last-checked -inf.0))
+          (package-info-set! 
-  (when (or force?
+           pkg-name 
-            (>= (- now last) (* 24 60 60)))
+           (hash-set i 'checksum-error (exn-message x))))])
-    (printf "\tupdating ~a\n" pkg-name)
+    (define i (package-info pkg-name))
-    (define new-checksum
+    (define old-checksum
-      (package-url->checksum
+      (package-ref i 'checksum))
-       (package-ref i 'source)))
+    (define now (current-seconds))
-    (package-begin
+    (define last (hash-ref i 'last-checked -inf.0))
-     (define* i
+    (when (or force?
-       (hash-set i 'checksum
+              (>= (- now last) (* 24 60 60)))
-                 (or new-checksum
+      (printf "\tupdating ~a\n" pkg-name)
-                     old-checksum)))
+      (define new-checksum
-     (define* i
+        (package-url->checksum
-       (hash-set i 'last-checked now))
+         (package-ref i 'source)))
-     (define* i
+      (package-begin
-       (hash-update i 'versions
+       (define* i
-                    (λ (v-ht)
+         (hash-set i 'checksum
-                      (for/hash ([(v vi) (in-hash v-ht)])
+                   (or new-checksum
-                        (define old-checksum (hash-ref vi 'checksum ""))
+                       old-checksum)))
-                        (define new-checksum
+       (define* i
-                          (package-url->checksum
+         (hash-set i 'last-checked now))
-                           (hash-ref vi 'source)))
+       (define* i
-                        (values v
+         (hash-update i 'versions
-                                (hash-set vi 'checksum
+                      (λ (v-ht)
-                                          (or new-checksum
+                        (for/hash ([(v vi) (in-hash v-ht)])
-                                              old-checksum)))))
+                          (define old-checksum (hash-ref vi 'checksum ""))
-                    hash))
+                          (define new-checksum
-     (define* i
+                            (package-url->checksum
-       (if (and new-checksum (equal? new-checksum old-checksum)
+                             (hash-ref vi 'source)))
-                ;; update if 'modules was not present:
+                          (values v
-                (hash-ref i 'modules #f))
+                                  (hash-set vi 'checksum
-         i
+                                            (or new-checksum
-         (hash-set (update-from-content i) 'last-updated now)))
+                                                old-checksum)))))
-     (package-info-set! pkg-name i))))
+                      hash))
+       (define* i
+         (if (and new-checksum (equal? new-checksum old-checksum)
+                  ;; update if 'modules was not present:
+                  (hash-ref i 'modules #f))
+           i
+           (hash-set (update-from-content i) 'last-updated now)))
+       (define* i
+         (hash-set i 'checksum-error #f))
+       (package-info-set! pkg-name i)))))
 
 (define (update-from-content i)
   (define-values (checksum module-paths dependencies)
@@ -993,7 +1011,7 @@
       (module-lists-conflict? left-m right-m)
       ;; We have to say #t here because otherwise things with no
       ;; information won't be conflicting.
-      #t))  
+      #t))
   (define conflict-cache
     (make-hash))
   (define (packages-conflict?/cache left right)
@@ -1008,7 +1026,7 @@
   (define ring-01
     (append (ring 0) (ring 1)))
   (define (package-conflicts? pkg)
-    (filter (λ (other-pkg) 
+    (filter (λ (other-pkg)
               (if (equal? pkg other-pkg)
                 #f
                 (packages-conflict?/cache pkg other-pkg)))