~ chicken-core (chicken-5) 46b8c3ec8ad706ae8042989c96f44e5d8af0603e


commit 46b8c3ec8ad706ae8042989c96f44e5d8af0603e
Author:     Timo Myyrä <timo.myyra@wickedbsd.net>
AuthorDate: Fri Mar 25 16:11:41 2016 +0200
Commit:     Evan Hanson <evhan@foldling.org>
CommitDate: Mon Mar 28 13:22:26 2016 +1300

    Add support for sudo alternatives through $SUDO environment variable
    
    We fall back to "sudo" if the environment variable isn't set.
    
    Thanks to Timo Myyrä.
    
    Signed-off-by: Peter Bex <peter@more-magic.net>
    Signed-off-by: Evan Hanson <evhan@foldling.org>

diff --git a/NEWS b/NEWS
index 390155ff..40fbf7bb 100644
--- a/NEWS
+++ b/NEWS
@@ -60,6 +60,8 @@
     - -prefix and -deploy options were added, matching chicken-install.
   - "chicken-status"
     - -prefix and -deploy options were added, matching chicken-install.
+  - The -sudo and -s options for chicken-install and chicken-uninstall
+    now honor a "SUDO" environment variable (thanks to Timo Myyrä).
 
 4.10.1
 
diff --git a/chicken-install.1 b/chicken-install.1
index 065f9878..359e5404 100644
--- a/chicken-install.1
+++ b/chicken-install.1
@@ -45,6 +45,10 @@ path selected during configuration (usually
 .B $prefix/lib/chicken/<binary\-version>
 )
 
+.TP
+.B SUDO
+The command to execute when using \-s flag in command. If not provided, defaults to the sudo(1).
+
 .SH DOCUMENTATION
 
 More information can be found in the
diff --git a/chicken-install.scm b/chicken-install.scm
index 74201605..610097da 100644
--- a/chicken-install.scm
+++ b/chicken-install.scm
@@ -805,7 +805,7 @@ usage: chicken-install [OPTION | EXTENSION[:VERSION]] ...
   -l   -location LOCATION       install from given location instead of default
   -t   -transport TRANSPORT     use given transport instead of default
        -proxy HOST[:PORT]       download via HTTP proxy
-  -s   -sudo                    use sudo(1) for filesystem operations
+  -s   -sudo                    use external command to elevate privileges for filesystem operations
   -r   -retrieve                only retrieve egg into current directory, don't install
   -n   -no-install              do not install, just build (implies `-keep')
   -p   -prefix PREFIX           change installation prefix to PREFIX
@@ -829,7 +829,7 @@ usage: chicken-install [OPTION | EXTENSION[:VERSION]] ...
        -show-depends            display a list of egg dependencies for the given egg(s)
        -show-foreign-depends    display a list of foreign dependencies for the given egg(s)
 
-chicken-install recognizes the http_proxy, and proxy_auth environment variables, if set.
+chicken-install recognizes the SUDO, http_proxy and proxy_auth environment variables, if set.
 
 EOF
 );|
diff --git a/chicken-uninstall.1 b/chicken-uninstall.1
index 8767cc61..90b6f460 100644
--- a/chicken-uninstall.1
+++ b/chicken-uninstall.1
@@ -44,6 +44,9 @@ path selected during configuration (usually
 .B $prefix/lib/chicken/<binary\-version>
 )
 
+.TP
+.B SUDO
+The command to execute when using \-s flag in command. If not provided, defaults to the sudo(1).
 
 .SH DOCUMENTATION
 
diff --git a/chicken-uninstall.scm b/chicken-uninstall.scm
index 04250edf..488cc8a6 100644
--- a/chicken-uninstall.scm
+++ b/chicken-uninstall.scm
@@ -109,7 +109,7 @@ usage: chicken-uninstall [OPTION | PATTERN] ...
        -version                 show version and exit
        -force                   don't ask, delete whatever matches
        -exact                   treat PATTERN as exact match (not a pattern)
-  -s   -sudo                    use sudo(1) for deleting files
+  -s   -sudo                    use external command to elevate privileges for deleting files
   -p   -prefix PREFIX           change installation prefix to PREFIX
        -deploy                  prefix is a deployment directory
        -host                    when cross-compiling, uninstall host extensions only
diff --git a/manual/Extensions b/manual/Extensions
index 93ebf06a..41a2568d 100644
--- a/manual/Extensions
+++ b/manual/Extensions
@@ -557,7 +557,7 @@ Available options:
 ; {{-t   -transport TRANSPORT}} : use given transport instead of default
 ; {{-list}} : list extensions available
 ; {{-proxy HOST[:PORT]}} : connect via HTTP proxy
-; {{-s   -sudo}} : use {{sudo(1)}} for installing or removing files
+; {{-s   -sudo}} : use external command to elevate privileges when installing or removing files
 ; {{-r   -retrieve}} : only retrieve egg into current directory, don't install
 ; {{-n   -no-install}} : do not install, just build (implies {{-keep}})
 ; {{-p   -prefix PREFIX}} : change installation prefix to {{PREFIX}}
@@ -580,7 +580,7 @@ Available options:
 ; {{-override FILENAME}} : override versions for installed eggs with information given in {{FILENAME}}, which can be generated by {{-scan}} or by the {{-list}} option of the {{chicken-status}} program
 ; {{-csi FILENAME}} : when invoking {{csi}}, the CHICKEN interpreter for executing installation scripts, use this program instead.
 
-{{chicken-install}} recognizes the {{http_proxy}} and {{proxy_auth}} environment variables, if set.
+{{chicken-install}} recognizes the {{SUDO}}, {{http_proxy}} and {{proxy_auth}} environment variables, if set.
 
 
 === chicken-uninstall reference
@@ -588,7 +588,7 @@ Available options:
 ; {{-h   -help}} : show usage information and exit
 ; {{-version}} : show version and exit
 ; {{-force}} : don't ask, delete whatever matches
-; {{-s   -sudo}} : use {{sudo(1)}} for deleting files
+; {{-s   -sudo}} : use external command to elevate privileges for deleting files
 ; {{-p   -prefix PREFIX}} : change installation prefix to {{PREFIX}}
 ; {{-deploy}} : uninstall extension from the application directory for a deployed application (see [[Deployment]] for more information)
 ; {{-host}} : when cross-compiling, remove extensions for host system only
diff --git a/setup-api.scm b/setup-api.scm
index d675f0f6..f4168a6a 100644
--- a/setup-api.scm
+++ b/setup-api.scm
@@ -155,12 +155,13 @@
   (print "Warning: cannot install as superuser with Windows") )
 
 (define (unix-sudo-install-setup)
-  (set! *copy-command*        "sudo cp -r")
-  (set! *remove-command*      "sudo rm -fr")
-  (set! *move-command*        "sudo mv")
-  (set! *chmod-command*       "sudo chmod")
-  (set! *ranlib-command*      "sudo ranlib")
-  (set! *mkdir-command*       "sudo mkdir") )
+  (let ((sudo-cmd (qs (or (get-environment-variable "SUDO") "sudo"))))
+    (set! *copy-command* (sprintf "~a cp -r" sudo-cmd))
+    (set! *remove-command* (sprintf "~a rm -rf" sudo-cmd))
+    (set! *move-command* (sprintf "~a mv" sudo-cmd))
+    (set! *chmod-command* (sprintf "~a chmod" sudo-cmd))
+    (set! *ranlib-command* (sprintf "~a ranlib" sudo-cmd))
+    (set! *mkdir-command* (sprintf "~a mkdir" sudo-cmd))))
 
 (define (user-install-setup)
   (set! *sudo* #f)
@@ -608,7 +609,10 @@
 	     (error 'remove-directory "cannot remove - directory not found" dir)
 	     #f))
 	(*sudo*
-	 (ignore-errors ($system (sprintf "sudo rm -fr ~a" (shellpath dir)))))
+	 (ignore-errors
+	  (let ((sudo-cmd (or (get-environment-variable "SUDO") "sudo")))
+	    ($system (sprintf "~a rm -fr ~a" (qs sudo-cmd)
+			      (shellpath dir))))))
 	(else
 	 (let walk ((dir dir))
 	   (let ((files (directory dir #t)))
Trap