cl-xdg-trash/trash.lisp

(in-package :cl-xdg-trash)

(declaim (ftype (function () integer) getuid))
(defun getuid ()
  "Return the current user's UID."
  (osicat-posix:getuid))

(declaim (ftype (function (&key (:homedir (or pathname string null))) pathname)
                xdg-data-home))
(defun xdg-data-home (&key homedir)
  (let ((env (uiop:getenv "XDG_DATA_HOME")))
    (cond
      (env (uiop:parse-native-namestring
            (pathname env) :ensure-directory t))
      ((not homedir)
       (merge-pathnames #P".local/share/"
                        (user-homedir-pathname)))
      ((pathnamep homedir)
       (merge-pathnames #P".local/share/"
                        (uiop:ensure-directory-pathname homedir)))
      (t
       (merge-pathnames #P".local/share/"
                        (uiop:parse-native-namestring homedir
                                                      :ensure-directory t))))))

(declaim (ftype (function (&key (:homedir (or pathname string null))) pathname)
                user-home-trash-directory))
(defun user-home-trash-directory (&key homedir)
  (merge-pathnames #P"Trash/" (xdg-data-home :homedir homedir)))

(declaim (ftype (function ((or string pathname)) list) find-trash-dirs-for-toplevel))
(defun find-trash-dirs-for-toplevel (toplevel)
  "List the trash directories that exist under TOPLEVEL."
  (let ((top-path (ensure-nonwild-pathname toplevel :ensure-directory t))
        found)
    (let ((dir (merge-pathnames #P".Trash" top-path)))
      (when (uiop:directory-exists-p dir)
        (push dir found)))
    (let ((uid (getuid)))
      (when uid
        (let ((dir (merge-pathnames (pathname (format nil ".Trash-~D" uid))
                                    top-path)))
          (when (uiop:directory-exists-p dir)
            (push dir found)))))
    found))

(declaim (ftype (function () list) list-toplevel-trash-directories))
(defun list-toplevel-trash-directories ()
  "List all known trash directories other than the user's trash directory."
  (mapcan 'find-trash-dirs-for-toplevel (list-mountpoints)))

(declaim (ftype (function () list) list-trash-directories))
(defun list-trash-directories ()
  "List all known trash directories."
  (cons (user-home-trash-directory) (list-toplevel-trash-directories)))

(declaim (ftype (function ((or pathname string) &key (:include-self t)) t)
                path-in-home-directory-p))
(defun path-in-home-directory-p (path &key include-self)
  "Return non-nil if PATH is in the user's home directory (or is the user's home
directory)."
  (let ((path (ensure-nonwild-pathname path :ensure-directory t))
        (home (user-homedir-pathname)))
    (or (and include-self (uiop:pathname-equal path home))
        (uiop:subpathp path home))))

(declaim (ftype (function ((or pathname string)) pathname)
                trash-directory-for-file))
(defun trash-directory-for-file (path)
  "Return the trash directory into which PATH should be trashed."
  (let* ((res-path (ensure-nonwild-pathname path))
         (root (find-filesystem-root res-path)))
    (or (and (path-in-home-directory-p res-path)
             (uiop:pathname-equal (find-filesystem-root (user-homedir-pathname))
                                  root)
             (car (find-trash-dirs-for-toplevel root)))
        (user-home-trash-directory))))

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