Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-05-21 22:59:16 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Merge pull request #611 from ilammy/snow-remove

Browse source 
Use sudo when doing "snow-chibi remove"
This commit is contained in:
Alex Shinn 2020-02-03 22:21:15 +08:00 • committed by GitHub
commit 77dad5af5c
No known key found for this signature in database
GPG key ID: 4AEE18F83AFDEB23
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))