Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-19 13:49:17 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

adding more warnings for bad repos (issue #846)

Browse source
This commit is contained in:
Alex Shinn 2022-08-08 18:59:50 +09:00
parent 1f1b361010
commit 51beea2bb6
1 changed files with 13 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
lib/chibi/snow/commands.scm
View file

@ -1159,9 +1159,9 @@
`(,(car repo) (url ,repo-uri) ,@(cdr repo)))))) `(,(car repo) (url ,repo-uri) ,@(cdr repo))))))
(cond (cond
((not (valid-repository? repo)) ((not (valid-repository? repo))
(warn "not a valid repository: " repo-uri repo)) (warn "not a valid repository" repo-uri repo))
((not (create-directory* local-dir)) ((not (create-directory* local-dir))
(warn "can't create directory: " local-dir)) (warn "can't create directory" local-dir))
(else (else
(guard (exn (else (die 2 "couldn't write repository"))) (guard (exn (else (die 2 "couldn't write repository")))
(call-with-output-file local-tmp (call-with-output-file local-tmp
@ -1194,10 +1194,17 @@
;; returns the single repo as a sexp, updated as needed ;; returns the single repo as a sexp, updated as needed
(define (maybe-update-repository cfg repo-uri) (define (maybe-update-repository cfg repo-uri)
(or (guard (exn (else #f)) (or (guard (exn
(else
(warn "error updating remote repository: "
repo-uri " error: " exn)
#f))
(and (should-update-repository? cfg repo-uri) (and (should-update-repository? cfg repo-uri)
(update-repository cfg repo-uri))) (update-repository cfg repo-uri)))
(guard (exn (else '(repository))) (guard (exn
(else
(warn "error reading local repository: " exn)
'(repository)))
(call-with-input-file (repository-local-path cfg repo-uri) (call-with-input-file (repository-local-path cfg repo-uri)
read)))) read))))
@ -1249,7 +1256,8 @@
(lp (cdr ls) seen res) (lp (cdr ls) seen res)
(let* ((repo (maybe-update-repository cfg uri)) (let* ((repo (maybe-update-repository cfg uri))
(siblings (siblings
(if (and repo (conf-get cfg 'follow-siblings? #t)) (if (and (valid-repository? repo)
(conf-get cfg 'follow-siblings? #t))
(let ((uri-base (let ((uri-base
(if (string-suffix? "/" uri) (if (string-suffix? "/" uri)
uri uri