~ chicken-core (chicken-5) c833416695ea80377bf6869217ef882595bb6cba
commit c833416695ea80377bf6869217ef882595bb6cba Author: Evan Hanson <evhan@foldling.org> AuthorDate: Sat Jun 9 19:26:55 2018 +1200 Commit: Kooda <kooda@upyum.com> CommitDate: Mon Jul 16 12:22:13 2018 +0200 Forbid relative pathnames in CHICKEN_INSTALL_REPOSITORY Signed-off-by: Kooda <kooda@upyum.com> diff --git a/chicken-install.scm b/chicken-install.scm index 80c990bb..eb484f28 100644 --- a/chicken-install.scm +++ b/chicken-install.scm @@ -1062,7 +1062,9 @@ EOF (rx (irregex "([^:]+):(.+)"))) (let loop ((args args)) (if (null? args) - (perform-actions (reverse eggs)) + (begin + (validate-environment) + (perform-actions (reverse eggs))) (let ((arg (car args))) (cond ((member arg '("-h" "-help" "--help")) (usage 0)) diff --git a/chicken-uninstall.scm b/chicken-uninstall.scm index 148bc880..9d3ba9b2 100644 --- a/chicken-uninstall.scm +++ b/chicken-uninstall.scm @@ -156,6 +156,7 @@ EOF (let loop ((args args) (pats '())) (cond ((null? args) (when (null? pats) (usage 1)) + (validate-environment) (uninstall (reverse pats) mtch)) (else (let ((arg (car args))) diff --git a/egg-environment.scm b/egg-environment.scm index 63ea472f..f27ea097 100644 --- a/egg-environment.scm +++ b/egg-environment.scm @@ -96,6 +96,11 @@ EOF (define +status-file+ "STATUS") (define +egg-extension+ "egg") +(define (validate-environment) + (let ((var (get-environment-variable "CHICKEN_INSTALL_REPOSITORY"))) + (unless (or (not var) (absolute-pathname? var)) + (error "CHICKEN_INSTALL_REPOSITORY must be an absolute pathname" var)))) + (define (destination-repository mode #!optional run) (if (eq? 'target mode) (if run target-run-repo target-repo)Trap