~ 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