~ 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