Asking for confirmation instead of failing automatically

on digest and signature mismatches.

lib/chibi/snow/commands.scm

@@ -1010,13 +1010,29 @@
         (substring-cursor file (string-cursor-next file pos))
         file)))
 
+(define (package-maybe-digest-mismatches impl cfg pkg raw)
+  (and (not (conf-get cfg 'ignore-digests?))
+       (let ((res (package-digest-mismatches cfg pkg raw)))
+         (and res
+              (not (yes-or-no? cfg "Package checksum mismatches: " res
+                               "\nProceed anyway?"))
+              res))))
+
+(define (package-maybe-signature-mismatches repo impl cfg pkg raw)
+  (and (not (conf-get cfg 'ignore-signature?))
+       (let ((res (package-signature-mismatches repo cfg pkg raw)))
+         (and res
+              (not (yes-or-no? cfg "Package signature mismatches: " res
+                               "\nProceed anyway?"))
+              res))))
+
 (define (install-package repo impl cfg pkg)
   (let* ((url (package-url repo pkg))
          (raw (fetch-package cfg url)))
     (cond
-     ((package-digest-mismatches cfg pkg raw)
+     ((package-maybe-digest-mismatches impl cfg pkg raw)
       => (lambda (x) (die 2 "package checksum didn't match: " x)))
-     ((package-signature-mismatches repo cfg pkg raw)
+     ((package-maybe-signature-mismatches repo impl cfg pkg raw)
       => (lambda (x) (die 2 "package signature didn't match: " x)))
      (else
       (let ((snowball (maybe-gunzip raw)))

lib/chibi/snow/package.scm

@@ -96,9 +96,8 @@
 
 (define (package-url repo pkg)
   (let ((url (and (pair? pkg) (assoc-get (cdr pkg) 'url eq?))))
-    (if (and url (uri-has-scheme? url))
-        url
-        (uri-with-path (string->path-uri 'http (repo-url repo)) url))))
+    (and url
+         (uri-resolve url (string->path-uri 'http (repo-url repo))))))
 
 (define (package-version pkg)
   (and (pair? pkg) (assoc-get (cdr pkg) 'version eq?)))
@@ -161,13 +160,15 @@
   (or (and (pair? pkg) (assoc-get-list (cdr pkg) 'installed-files)) '()))
 
 (define (library-name->path name)
-  (call-with-output-string
-    (lambda (out)
-      (let lp ((name name))
-        (display (car name) out)
-        (cond ((pair? (cdr name))
-               (write-char #\/ out)
-               (lp (cdr name))))))))
+  (if (null? name)
+      ""
+      (call-with-output-string
+        (lambda (out)
+          (let lp ((name name))
+            (display (car name) out)
+            (cond ((pair? (cdr name))
+                   (write-char #\/ out)
+                   (lp (cdr name)))))))))
 
 ;; map a library to the path name it would be found in (sans extension)
 (define (library->path library)
@@ -205,7 +206,8 @@
   (and (pair? lib) (assoc-get (cdr lib) 'url eq?)))
 
 (define (library-dependencies lib)
-  (assoc-get-list (cdr lib) 'depends))
+  (cond ((assq 'depends (cdr lib)) => cdr)
+        (else '())))
 
 (define (parse-library-name str)
   (cond

tools/snow-chibi

@@ -56,6 +56,8 @@
   ;; name type aliases doc
   '((verbose? boolean (#\v "verbose") "print additional informative messages")
     (always-yes? boolean (#\y "always-yes") "answer all questions with yes")
+    (ignore-signature? boolean ("ignore-sig") "don't verify package signatures")
+    (ignore-digest? boolean ("ignore-digest") "don't verify package checksums")
     ;;(config filename "path to configuration file")
     (host string "base uri of snow repository")
     (repository-uri string "uri of snow repository file")