Zander671/cl-xdg-trash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Lots of work

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-10-17 16:47:03 -07:00
parent 9ab3a6c374
commit c309b1df38
6 changed files with 284 additions and 43 deletions
Download Patch File Download Diff File Expand all files Collapse all files

3
cl-xdg-trash.asd
View File

@ -5,13 +5,14 @@
:maintainer "Alexander Rosenberg <zanderpkg@pm.me>"
:homepage "https://git.zander.im/Zander671/cl-xdg-trash"
:license "GPL3"
:depends-on (#:local-time #:uiop #:trivial-features #:yason #:cffi)
:depends-on (#:local-time #:uiop #:trivial-features :osicat)
:serial t
:components
((:file "package")
(:file "url-encode")
(:file "mountpoints")
(:file "trashinfo")
(:file "directorysizes")
(:file "trash"))
:long-description
#.(uiop:read-file-string

155
directorysizes.lisp Normal file
View File

@ -0,0 +1,155 @@
(in-package :cl-xdg-trash/directorysizes)
(declaim (ftype (function ((or string pathname)) integer) regular-file-size))
(defun regular-file-size (path)
"Return the size (in bytes) of the non-directory file PATH."
(let ((res (osicat-posix:stat (uiop:native-namestring
(ensure-nonwild-pathname path)))))
(when (osicat-posix:s-isdir (osicat-posix:stat-mode res))
(error 'file-error :pathname path))
(osicat-posix:stat-size res)))
(declaim (ftype (function ((or string pathname)) integer) file-size))
(defun file-size (path)
"Return the size of the file (inode) named by PATH."
(loop for queue = (list (ensure-nonwild-pathname path)) then queue
while queue
for cur = (first queue)
for res = (osicat-posix:stat cur)
do (pop queue)
when (osicat-posix:s-isdir (osicat-posix:stat-mode res))
do (setq queue (nconc (uiop:directory*
(merge-pathnames
uiop:*wild-file-for-directory* cur))
queue))
else
summing (regular-file-size cur)))
(declaim (ftype (function (string character &optional (or null integer)) list)
split-string))
(defun split-string (string seperator &optional max)
"Split STRING on SEPERATOR, a character. If MAX is an integer, return a list
of at most MAX elements, with the last element being the remaining, un-split
part of STRING."
(loop with start = 0
with count = 0
for i below (length string)
while (or (not (integerp max)) (< count (1- max)))
for char = (aref string i)
when (eql char seperator)
collect (subseq string start i) into out
and do (setq start (1+ i)
count (1+ count))
finally (return (progn
(nconc out (list (subseq string start)))))))
(defstruct directorysizes-entry
"Single entry in a directorysizes file."
size mtime name)
(declaim (ftype (function (stream) hash-table) parse-directorysizes))
(defun parse-directorysizes (stream)
"Parse the directorysizes file read from STREAM."
(loop with out = (make-hash-table :test #'equal)
for line = (read-line stream nil)
while line
for (size mtime encoded-name) = (split-string line #\Space 3)
for name = (url-decode encoded-name)
do (setf (gethash name out)
(make-directorysizes-entry
:size (parse-integer size)
:mtime (parse-integer mtime)
:name name))
finally (return out)))
(declaim (ftype (function ((or string pathname)) hash-table)
read-directorysizes-file))
(defun read-directorysizes-file (path)
"Read the directorysizes file PATH."
(with-open-file (stream (ensure-nonwild-pathname path))
(parse-directorysizes stream)))
(declaim (ftype (function ((or string pathname)) pathname)
calculate-direcotrysizes-path))
(defun calculate-direcotrysizes-path (trash-directory)
"Return the directorysizes file for TRASH-DIRECTORY."
(merge-pathnames #P"directorysizes"
(ensure-nonwild-pathname trash-directory
:ensure-directory t)))
(declaim (ftype (function ((or boolean stream) hash-table) t)
format-directorysizes))
(defun format-directorysizes (stream directorysizes)
"Write DIRECTORYSIZES to STREAM."
(loop for name being the hash-keys of directorysizes
using (hash-value entry)
do (with-slots (size mtime) entry
(format stream "~A ~A ~A~%" size mtime (url-encode name)))))
(defmacro with-atomic-write ((stream path) &body body)
"Evaluate BODY with STREAM bound to a stream that will write to a temporary
file. If execution is successful, rename this temporary file to PATH, replacing
it."
(let ((tmp-path (gensym "TMP-PATH-"))
(target-path (gensym "TARGET-PATH-"))
(dir (gensym "DIR")))
`(let* ((,target-path (ensure-nonwild-pathname ,path))
(,dir (uiop:pathname-parent-directory-pathname ,target-path)))
(uiop:call-with-temporary-file
#'(lambda (,stream ,tmp-path)
,@body
(osicat-posix:rename
(uiop:native-namestring ,tmp-path)
(uiop:native-namestring ,target-path)))
:keep t :directory ,dir :type nil))))
(declaim (ftype (function ((or string pathname) string))
update-directorysizes-entry))
(defun trashed-file-size (trash-directory name)
"Return the size of the trashed file NAME in TRASH-DIRECTORY. If NAME is a
directory and the file size cache is out of date, update it."
(let* ((directorysizes-path (calculate-direcotrysizes-path trash-directory))
(directorysizes (handler-case
(read-directorysizes-file directorysizes-path)
(file-error ()
(make-hash-table :test #'equal))))
(cur-entry (gethash name directorysizes))
(path (merge-pathnames (make-pathname :name name
:directory '(:relative "files"))
(ensure-nonwild-pathname trash-directory
:ensure-directory t)))
(stat (handler-case
(osicat-posix:stat (uiop:native-namestring path))
(t nil nil)))
(trashinfo-mtime
(handler-case (osicat-posix:stat-mtime
(osicat-posix:stat (uiop:native-namestring
(compute-trashinfo-source-file
trash-directory name))))
(t nil nil)))
did-change ret-size)
(cond
((not stat)
(setf did-change (remhash name directorysizes)))
((not (osicat-posix:s-isdir (osicat-posix:stat-mode stat)))
(setf did-change (remhash name directorysizes)
ret-size (osicat-posix:stat-size stat)))
((and (directorysizes-entry-p cur-entry)
(eql (directorysizes-entry-mtime cur-entry)
trashinfo-mtime))
(setq ret-size (directorysizes-entry-size cur-entry)))
(t
(let ((orig-size (gethash name directorysizes))
(size (file-size path)))
(setf (gethash name directorysizes)
(make-directorysizes-entry
:mtime trashinfo-mtime
:size size
:name name)
did-change (not (eql size orig-size))
ret-size size))))
(when did-change
(with-atomic-write (stream directorysizes-path)
(format-directorysizes stream directorysizes)))
ret-size))

20
mountpoints.lisp
View File

@ -60,11 +60,17 @@ return file-systems that were mounted read-write."
(defun device-id-for-path (path)
"Return the device id for the device on which PATH resides, or nil if it can't
be determined."
#+sbcl (handler-case
(sb-posix:stat-dev (sb-posix:stat path))
(sb-posix:syscall-error ()
nil))
#-(or sbcl) nil)
(handler-case
(osicat-posix:stat-dev (osicat-posix:stat path))
(osicat-posix:posix-error ()
nil)))
(declaim (ftype (function (string string) string) remove-suffix))
(defun remove-suffix (string suffix)
"Return STRING without SIFFIX."
(if (uiop:string-suffix-p string suffix)
(subseq string 0 (- (length string) (length suffix)))
string))
(declaim (ftype (function ((or pathname string) &key (:ensure-directory t))
pathname)
@ -85,8 +91,8 @@ be determined."
"Return the name of the last component of PATH, be it a file or directory."
(if (uiop:pathname-equal path "/")
"/"
(first (last (pathname-directory
(ensure-nonwild-pathname path :ensure-directory t))))))
(let ((unix-path (remove-suffix (uiop:unix-namestring path) "/")))
(first (last (uiop:split-string unix-path :max 2 :separator '(#\/)))))))
(declaim (ftype (function ((or string pathname)) (or pathname null))
deepest-existing-path))

25
package.lisp
View File

@ -14,6 +14,7 @@
(:export #:list-mountpoints
#:find-filesystem-root
#:ensure-nonwild-pathname
#:remove-suffix
#:file-or-dir-namestring))
(defpackage :cl-xdg-trash/trashinfo
@ -25,7 +26,8 @@
#:url-decode)
(:import-from #:cl-xdg-trash/mountpoints
#:file-or-dir-namestring
#:ensure-nonwild-pathname)
#:ensure-nonwild-pathname
#:remove-suffix)
(:export #:trashinfo-format-error
#:trashinfo-format-error-message
#:trashinfo-format-error-line-numer
@ -34,17 +36,34 @@
#:trashinfo
#:trashinfo-trash-directory
#:trashinfo-name
#:trashinfo-path
#:trashinfo-original-path
#:trashinfo-deletion-date
#:trashinfo-info-file
#:trashinfo-trashed-file
#:compute-trashinfo-source-file
#:parse-trashinfo-from-stream
#:parse-trashinfo-file
#:format-trashinfo
#:make-trashinfo-for))
(defpackage :cl-xdg-trash/directorysizes
(:documentation
"Parser and utility functions for dealing with the directorysizes file.")
(:use #:cl)
(:import-from #:cl-xdg-trash/mountpoints
#:ensure-nonwild-pathname)
(:import-from #:cl-xdg-trash/url-encode
#:url-encode
#:url-decode)
(:import-from #:cl-xdg-trash/trashinfo
#:compute-trashinfo-source-file)
(:export #:read-directorysizes-file
#:prase-directorysizes
#:trashed-file-size))
(defpackage :cl-xdg-trash
(:documentation
"Common Lisp interface to the XDG trash specification.")
(:use #:cl #:cl-xdg-trash/trashinfo #:cl-xdg-trash/url-encode
#:cl-xdg-trash/mountpoints)
#:cl-xdg-trash/mountpoints #:cl-xdg-trash/directorysizes)
(:export))

76
trash.lisp
View File

@ -1,10 +1,9 @@
(in-package :cl-xdg-trash)
(declaim (ftype (function () (or integer null)) getuid))
(declaim (ftype (function () integer) getuid))
(defun getuid ()
"Return the current user's UID, or nil if it cannot be determined."
#+sbcl (sb-posix:getuid)
#-(or sbcl) nil)
"Return the current user's UID."
(osicat-posix:getuid))
(declaim (ftype (function (&key (:homedir (or pathname string null))) pathname)
xdg-data-home))
@ -77,16 +76,73 @@ directory)."
(car (find-trash-dirs-for-toplevel root)))
(user-home-trash-directory))))
(declaim (ftype (function ((or pathname string)) t) trash-file))
(defun trash-file (path)
(declaim (ftype (function ((or pathname string) &optional t) t) trash-file))
(defun trash-file (path &optional (update-size-cache t))
"Move PATH to the trash. Specifically, move it to the proper trash as
specified by the XDG standard."
specified by the XDG standard. If UPDATE-SIZE-CACHE is non-nil (the default)
also update the directory size cache."
(let* ((path (merge-pathnames (ensure-nonwild-pathname path) (uiop:getcwd)))
(trash-directory (trash-directory-for-file path))
(trashinfo (make-trashinfo-for trash-directory path))
(files-dir (ensure-directories-exist (merge-pathnames
#P"files/" trash-directory)
:verbose nil)))
(rename-file path (merge-pathnames
(make-pathname :name (trashinfo-name trashinfo))
files-dir))))
(osicat-posix:rename (uiop:native-namestring path)
(uiop:native-namestring
(merge-pathnames
(make-pathname :name (trashinfo-name trashinfo))
files-dir)))
(when update-size-cache
(trashed-file-size trash-directory (trashinfo-name trashinfo)))))
(declaim (ftype (function ((or pathname string list)) list)
normalize-trash-directories)
(inline normalize-trash-directories))
(defun normalize-trash-directories (trash-directories)
"Normalize TRASH-DIRECTORIES to a non-wild list of pathnames."
(if (or (stringp trash-directories) (pathnamep trash-directories))
(list (ensure-nonwild-pathname trash-directories :ensure-directory t))
(mapcar #'(lambda (elt)
(ensure-nonwild-pathname elt :ensure-directory t))
trash-directories)))
(declaim (ftype (function (pathname) list) list-trashed-files-for-directory))
(defun list-trasheds-file-for-directory (trash-directory)
"Return a list of trashinfo objects for every trashed file in
TRASH-DIRECTORY."
(let ((info-dir (merge-pathnames #P"info/" trash-directory)))
(mapcan #'(lambda (path)
(let ((name (file-or-dir-namestring path)))
(when (uiop:string-suffix-p name ".trashinfo")
(list (parse-trashinfo-file
trash-directory
(subseq name 0 (- (length name)
(length ".trashinfo"))))))))
(uiop:directory-files info-dir))))
(declaim (ftype (function (&optional (or pathname string list)) list)
normalize-trash-directories))
(defun list-trashed-files (&optional (trash-directories (list-trash-directories)))
"Return a list of trashinfo objects for each trashed file in
TRASH-DIRECTORIES. TRASH-DIRECTORIES can also be a single path."
(mapcan #'list-trashed-file-for-directory
(normalize-trash-directories trash-directories)))
(declaim (ftype (function (trashinfo &optional t) t) restore-file))
(defun restore-file (trashinfo &optional (update-size-cache t))
"Restore the file pointed to by TRASHINFO. If UPDATE-SIZE-CACHE is non-nil
(the default), also update the directory size cache."
(osicat-posix:rename
(uiop:native-namestring (trashinfo-trashed-file trashinfo))
(uiop:native-namestring (trashinfo-original-path trashinfo)))
(handler-bind
;; attempt to re-trash the file in case of error
((t #'(lambda (e)
(osicat-posix:rename
(uiop:native-namestring (trashinfo-original-path trashinfo))
(uiop:native-namestring (trashinfo-trashed-file trashinfo)))
(signal e))))
(delete-file (trashinfo-info-file trashinfo))
(when update-size-cache
(trashed-file-size (trashinfo-trash-directory trashinfo)
(trashinfo-name trashinfo)))))

48
trashinfo.lisp
View File

@ -33,10 +33,10 @@ trashinfo file belongs to.")
:initarg :name
:type string
:documentation "The name of this trashinfo file without the extension.")
(path :reader trashinfo-path
:initarg :path
:type pathname
:documentation "Path to the original location of the file.")
(original-path :reader trashinfo-original-path
:initarg :original-path
:type pathname
:documentation "Path to the original location of the file.")
(deletion-date :reader trashinfo-deletion-date
:initarg :deletion-date
:type local-time:timestamp
@ -44,6 +44,16 @@ trashinfo file belongs to.")
trashed."))
(:documentation "Represents a .trashinfo file."))
(defmethod print-object ((obj trashinfo) stream)
(print-unreadable-object (obj stream :type t :identity t)
(princ (trashinfo-name obj) stream)))
(defmethod trashinfo-info-file ((trashinfo trashinfo))
(with-slots (name trash-directory) trashinfo
(merge-pathnames (make-pathname :name (format nil "~A.trashinfo" name)
:directory '(:relative "info"))
trash-directory)))
(defmethod trashinfo-trashed-file ((trashinfo trashinfo))
(with-slots (name trash-directory) trashinfo
(merge-pathnames (make-pathname :name name :directory '(:relative "files"))
@ -81,13 +91,14 @@ trashed."))
(setq second (next-int 2))
(local-time:encode-timestamp 0 second minute hour day month year))))
(declaim (ftype (function (pathname string) pathname) compute-trashinfo-source-file))
(declaim (ftype (function ((or pathname string) string) pathname)
compute-trashinfo-source-file))
(defun compute-trashinfo-source-file (trash-directory name)
"Return the pathname object for the actual trashinfo file corresponding to the
trashed file NAME in TRASH-DIRECTORY."
(merge-pathnames (make-pathname :name name :type "trashinfo"
(merge-pathnames (make-pathname :name (format nil "~A.trashinfo" name)
:directory '(:relative "info"))
trash-directory))
(ensure-nonwild-pathname trash-directory :ensure-directory t)))
(declaim (ftype (function (pathname string stream &key (:source-file pathname))
trashinfo)
@ -137,7 +148,7 @@ trashed file NAME in TRASH-DIRECTORY."
"End-of-file without both \"Path\" and \"DeletionDate\"")
(return (make-instance 'trashinfo
:deletion-date deletion-date
:path path :name name
:original-path path :name name
:trash-directory trash-directory)))))
(declaim (ftype (function ((or pathname string) string) trashinfo)))
@ -169,9 +180,9 @@ TRASH-DIRECTORY. If SOURCE-FILE is not provided, it will be calculated."
format-trashinfo))
(defun format-trashinfo (trashinfo &optional stream)
"Write the trashinfo file out to STREAM."
(with-slots (path deletion-date) trashinfo
(with-slots (original-path deletion-date) trashinfo
(format stream "[Trash Info]~%Path=~A~%DeletionDate=~A~%"
(url-encode path :safe-chars '(#\/))
(url-encode original-path :safe-chars '(#\/))
(format-trashinfo-timestamp deletion-date))))
(declaim (ftype (function (pathname (or string pathname)) stream)
@ -187,9 +198,8 @@ TRASH-DIRECTORY. If SOURCE-FILE is not provided, it will be calculated."
:verbose nil)
for info-file = (merge-pathnames
(make-pathname
:name (format nil "~A-~D"
name (random most-positive-fixnum))
:type "trashinfo")
:name (format nil "~A-~D.trashinfo"
name (random most-positive-fixnum)))
info-dir)
for stream = (open info-file :direction :output
:if-exists nil
@ -197,13 +207,6 @@ TRASH-DIRECTORY. If SOURCE-FILE is not provided, it will be calculated."
until stream
finally (return stream)))
(declaim (ftype (function (string string) string) remove-suffix))
(defun remove-suffix (string suffix)
"Return STRING without SIFFIX."
(if (uiop:string-suffix-p string suffix)
(subseq string 0 (- (length string) (length suffix)))
string))
(declaim (ftype (function (pathname (or pathname string)
&optional local-time:timestamp)
trashinfo)
@ -221,8 +224,9 @@ TRASH-DIRECTORY. Return a trashinfo object pointing to this file."
(signal e))))
(let ((trashinfo
(make-instance 'trashinfo
:path (uiop:native-namestring
(merge-pathnames path (uiop:getcwd)))
:original-path (uiop:native-namestring
(merge-pathnames path
(uiop:getcwd)))
:name (remove-suffix
(file-or-dir-namestring
(pathname stream))