From 50a9c9d4d4d8abd697a6ba45ec641b6c603c7b28 Mon Sep 17 00:00:00 2001 From: Alexei Lozovsky Date: Sun, 2 Feb 2020 16:46:23 +0200 Subject: [PATCH] Use sudo when doing "snow-chibi remove" Currently "remove" command does not know how to use sudo to remove files installed into directories owned by root. By default Snow installs stuff into /usr/local hierarchy and uses sudo for that. Let's teach it to remove packages without explicit sudo too. --- lib/chibi/snow/commands.scm | 30 ++++++++++++++++++++++++------ 1 file changed, 24 insertions(+), 6 deletions(-) diff --git a/lib/chibi/snow/commands.scm b/lib/chibi/snow/commands.scm index 7369c203..ba689dc5 100644 --- a/lib/chibi/snow/commands.scm +++ b/lib/chibi/snow/commands.scm @@ -981,21 +981,39 @@ ;; Provides a summary of the libraries to remove along with any ;; dependencies they have which were not explicitly installed. -(define (warn-delete-file file) +(define (remove-with-sudo? cfg path) + (case (or (conf-get cfg '(command remove use-sudo?)) + (conf-get cfg '(command upgrade use-sudo?))) + ((always) #t) + ((never) #f) + (else + (not (file-is-writable? (path-directory path)))))) + +(define (remove-file cfg file) + (if (remove-with-sudo? cfg file) + (system "sudo" "rm" file) + (delete-file file))) + +(define (remove-directory cfg dir) + (if (remove-with-sudo? cfg dir) + (system "sudo" "rmdir" dir) + (delete-directory dir))) + +(define (warn-delete-file cfg file) (guard (exn (else (warn "couldn't delete file: " file))) - (delete-file file))) + (remove-file cfg file))) (define (delete-library-files impl cfg pkg lib-name) - (for-each warn-delete-file (package-installed-files pkg)) - (warn-delete-file (make-path (get-install-source-dir impl cfg) - (get-package-meta-file cfg pkg))) + (for-each (lambda (f) (warn-delete-file cfg f)) (package-installed-files pkg)) + (warn-delete-file cfg (make-path (get-install-source-dir impl cfg) + (get-package-meta-file cfg pkg))) (cond ((package->path cfg pkg) => (lambda (path) (let ((dir (make-path (get-install-source-dir impl cfg) path))) (if (and (file-directory? dir) (= 2 (length (directory-files dir)))) - (delete-directory dir))))))) + (remove-directory cfg dir))))))) (define (command/remove cfg spec . args) (let* ((impls (conf-selected-implementations cfg))