cl-xdg-trash/directorysizes.lisp

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