From c309b1df387398e5d2795ae2b3a50ef216edeef6 Mon Sep 17 00:00:00 2001 From: Alexander Rosenberg Date: Fri, 17 Oct 2025 16:47:03 -0700 Subject: [PATCH] Lots of work --- cl-xdg-trash.asd | 3 +- directorysizes.lisp | 155 ++++++++++++++++++++++++++++++++++++++++++++ mountpoints.lisp | 20 ++++-- package.lisp | 25 ++++++- trash.lisp | 76 +++++++++++++++++++--- trashinfo.lisp | 48 +++++++------- 6 files changed, 284 insertions(+), 43 deletions(-) create mode 100644 directorysizes.lisp diff --git a/cl-xdg-trash.asd b/cl-xdg-trash.asd index dd9f054..ca5f125 100644 --- a/cl-xdg-trash.asd +++ b/cl-xdg-trash.asd @@ -5,13 +5,14 @@ :maintainer "Alexander Rosenberg " :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 diff --git a/directorysizes.lisp b/directorysizes.lisp new file mode 100644 index 0000000..980139e --- /dev/null +++ b/directorysizes.lisp @@ -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)) diff --git a/mountpoints.lisp b/mountpoints.lisp index fb77750..53e7904 100644 --- a/mountpoints.lisp +++ b/mountpoints.lisp @@ -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)) diff --git a/package.lisp b/package.lisp index 5bffcf7..c02b1da 100644 --- a/package.lisp +++ b/package.lisp @@ -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)) diff --git a/trash.lisp b/trash.lisp index 3532e0d..12429e0 100644 --- a/trash.lisp +++ b/trash.lisp @@ -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))))) diff --git a/trashinfo.lisp b/trashinfo.lisp index 07b04af..c48e687 100644 --- a/trashinfo.lisp +++ b/trashinfo.lisp @@ -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))