Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-03 11:16:36 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions 1

Use sudo when doing "snow-chibi remove"

Browse source 
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.
This commit is contained in:
Alexei Lozovsky 2020-02-02 16:46:23 +02:00
parent 2b7927b9bc
commit 50a9c9d4d4
1 changed files with 24 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
lib/chibi/snow/commands.scm
View file

@ -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))