261 lines
11 KiB
Common Lisp
261 lines
11 KiB
Common Lisp
(in-package :cl-xdg-trash/directorysizes)
|
|
|
|
(declaim (ftype (function ((or string pathname) &optional t t) list)
|
|
list-directory))
|
|
(defun list-directory (path &optional relative include-dot)
|
|
"Return a list of each file in the directory named by PATH."
|
|
(let* ((path (ensure-nonwild-pathname path :ensure-directory t))
|
|
(abs-path (if relative path (merge-pathnames path)))
|
|
(stream (osicat-posix:opendir (uiop:native-namestring path))))
|
|
(unwind-protect
|
|
(loop for name = (osicat-posix:readdir stream)
|
|
while name
|
|
for name-pathname = (uiop:parse-native-namestring name)
|
|
when (or include-dot
|
|
(not (member name '("." "..") :test #'equal)))
|
|
collect (if relative
|
|
name-pathname
|
|
(merge-pathnames name-pathname abs-path)))
|
|
(when stream
|
|
(osicat-posix:closedir stream)))))
|
|
|
|
(declaim (ftype (function ((or string pathname) &optional t) integer) file-size))
|
|
(defun file-size (path &optional (no-errors t))
|
|
"Return the size of the file (inode) named by PATH. With NO-ERRORS, ignore any
|
|
errors during this process."
|
|
(loop for queue = (list (ensure-nonwild-pathname path)) then queue
|
|
while queue
|
|
for cur = (directory-as-file-pathname (first queue))
|
|
for res = (catch 'return-nil
|
|
(handler-bind
|
|
((osicat-posix:posix-error
|
|
(lambda (e)
|
|
(if no-errors
|
|
(throw 'return-nil nil)
|
|
(signal e)))))
|
|
(osicat-posix:lstat (uiop:native-namestring cur))))
|
|
do (pop queue)
|
|
when (and res (osicat-posix:s-isdir (osicat-posix:stat-mode res)))
|
|
do (setq queue (nconc (catch 'return-nil
|
|
(handler-bind
|
|
((osicat-posix:posix-error
|
|
(lambda (e)
|
|
(if no-errors
|
|
(throw 'return-nil nil)
|
|
(signal e)))))
|
|
(list-directory cur)))
|
|
queue))
|
|
else when res
|
|
summing (osicat-posix:stat-size res)))
|
|
|
|
(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)
|
|
when (and size mtime encoded-name)
|
|
do (handler-case
|
|
(setf (gethash name out)
|
|
(make-directorysizes-entry
|
|
:size (max 0 (parse-integer size))
|
|
:mtime (max 0 (parse-integer mtime))
|
|
:name name))
|
|
(parse-error ()))
|
|
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-directorysizes-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"))
|
|
(rval (gensym "RVAL")))
|
|
`(let* ((,target-path (ensure-nonwild-pathname ,path))
|
|
(,dir (parent-directory ,target-path))
|
|
,rval)
|
|
(uiop:call-with-temporary-file
|
|
#'(lambda (,stream ,tmp-path)
|
|
(setq ,rval (progn ,@body))
|
|
(osicat-posix:rename
|
|
(uiop:native-namestring ,tmp-path)
|
|
(uiop:native-namestring ,target-path)))
|
|
:keep t :directory ,dir :type nil)
|
|
,rval)))
|
|
|
|
(declaim (ftype (function ((or string pathname) &key (:default t)) t)
|
|
read-directorysizes-for-trash-directory))
|
|
(defun read-directorysizes-for-trash-directory
|
|
(trash-directory &key (default (make-hash-table :test #'equal)))
|
|
"Read the directorysizes file in TRASH-DIRECTORY. If the operation fails,
|
|
return DEFAULT (which defaults to an empty directorysizes table)."
|
|
(let ((path (calculate-directorysizes-path trash-directory)))
|
|
(handler-case
|
|
(read-directorysizes-file path)
|
|
(error () default))))
|
|
|
|
(declaim (ftype (function ((or string pathname) hash-table &optional t)
|
|
boolean)
|
|
write-directorysizes-for-trash-directory))
|
|
(defun write-directorysizes-for-trash-directory
|
|
(trash-directory directorysizes &optional no-error)
|
|
"Update the directorysizes file of TRASH-DIRECTORY with DIRECTORYSIZES. With
|
|
NO-ERROR, This will return t if the operation succeeded and nil otherwise."
|
|
(handler-bind
|
|
((error (lambda (e)
|
|
(if no-error
|
|
(return-from write-directorysizes-for-trash-directory)
|
|
(signal e)))))
|
|
(with-atomic-write
|
|
(stream (calculate-directorysizes-path trash-directory))
|
|
(format-directorysizes stream directorysizes)
|
|
t)))
|
|
|
|
(declaim (ftype (function ((or string pathname) string &key
|
|
(:directorysizes hash-table)
|
|
(:no-write t)
|
|
(:no-error t))
|
|
(or integer null))
|
|
update-directorysizes-entry))
|
|
(defun trashed-file-size
|
|
(trash-directory name
|
|
&key
|
|
(directorysizes (read-directorysizes-for-trash-directory
|
|
trash-directory))
|
|
no-write no-errors)
|
|
"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. As a second value,
|
|
return whether the cache actually needed updating. This can be inhibited by
|
|
setting NO-WRITE to a non-nil value. Optionally, you can pass a pre-read
|
|
directorysizes object to DIRECTORYSIZES (note that this object will be
|
|
destructively updated, even with NO-WRITE)."
|
|
(let* ((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:lstat (uiop:native-namestring path))
|
|
(t nil nil)))
|
|
(trashinfo-mtime
|
|
(handler-case
|
|
(osicat-posix:stat-mtime
|
|
(osicat-posix:lstat (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 ((size (if no-errors
|
|
;; as file-size's no-errors argument causes it to return
|
|
;; zero on error, we can't use it here (we want to return
|
|
;; nil)
|
|
(handler-case
|
|
(file-size path nil)
|
|
(error nil nil))
|
|
(file-size path nil))))
|
|
(when (setf ret-size size)
|
|
(setf (gethash name directorysizes)
|
|
(make-directorysizes-entry
|
|
:mtime trashinfo-mtime
|
|
:size size
|
|
:name name)
|
|
did-change t)))))
|
|
(when (and (not no-write) did-change)
|
|
(write-directorysizes-for-trash-directory
|
|
trash-directory directorysizes t))
|
|
(values ret-size did-change)))
|
|
|
|
(declaim (ftype (function (hash-table) list) hash-table-keys))
|
|
(defun hash-table-keys (table)
|
|
"Return the keys of TABLE."
|
|
(let (keys)
|
|
(maphash (lambda (k v)
|
|
(declare (ignore v))
|
|
(push k keys))
|
|
table)
|
|
keys))
|
|
|
|
(declaim (ftype (function ((or pathname string)
|
|
&key (:directorysizes hash-table) (:no-write t)
|
|
(:no-error t))
|
|
hash-table)
|
|
prune-directorysizes))
|
|
(defun prune-directorysizes
|
|
(directory &key (directorysizes
|
|
(read-directorysizes-for-trash-directory directory))
|
|
no-write no-error)
|
|
"Prune the directorysizes file of trash directory DIRECTORY. If you already
|
|
have the directorysizes hash-table for DIRECOTRY, pass it in DIRECTORYSIZES. The
|
|
pruned table will be returned (it is a copy). If NO-WRITE is nil, update the
|
|
actual cache file on disk as well."
|
|
(let ((found-names (mapcar #'trashinfo-name
|
|
(cl-xdg-trash:list-trashed-files directory)))
|
|
(new-ds (make-hash-table :test #'equal)))
|
|
(dolist (name found-names)
|
|
(let ((entry (gethash name directorysizes)))
|
|
(when entry
|
|
(setf (gethash name new-ds) entry))))
|
|
(unless no-write
|
|
(write-directorysizes-for-trash-directory directory new-ds no-error))
|
|
new-ds))
|