241 lines
11 KiB
Common Lisp
241 lines
11 KiB
Common Lisp
(in-package :cl-xdg-trash/trashinfo)
|
|
|
|
(define-condition trashinfo-format-error (parse-error)
|
|
((message :accessor trashinfo-format-error-message
|
|
:initarg :message
|
|
:type string
|
|
:documentation "A message describing the error.")
|
|
(line-number :accessor trashinfo-format-error-line-number
|
|
:initarg :line-number
|
|
:type (integer 1)
|
|
:documentation "The line number of the error. The first line is
|
|
line 1.")
|
|
(context :accessor trashinfo-format-error-context
|
|
:initarg :context
|
|
:type string
|
|
:documentation "The text of the line causing the error.")
|
|
(source-file :accessor trashinfo-format-error-source-file
|
|
:initarg :source-file
|
|
:type pathname
|
|
:documentation "The path to the file the error happened in."))
|
|
(:report (lambda (condition stream)
|
|
(with-slots (message line-number source-file) condition
|
|
(format stream "Error parsing ~A on line ~A: ~A."
|
|
source-file line-number message)))))
|
|
|
|
(defclass trashinfo ()
|
|
((trash-directory :reader trashinfo-trash-directory
|
|
:initarg :trash-directory
|
|
:type pathname
|
|
:documentation "The path to the trash directory that this
|
|
trashinfo file belongs to.")
|
|
(name :reader trashinfo-name
|
|
: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.")
|
|
(deletion-date :reader trashinfo-deletion-date
|
|
:initarg :deletion-date
|
|
:type local-time:timestamp
|
|
:documentation "The time the corresponding file was
|
|
trashed."))
|
|
(:documentation "Represents a .trashinfo file."))
|
|
|
|
(defmethod trashinfo-trashed-file ((trashinfo trashinfo))
|
|
(with-slots (name trash-directory) trashinfo
|
|
(merge-pathnames (make-pathname :name name :directory '(:relative "files"))
|
|
trash-directory)))
|
|
|
|
(declaim (ftype (function (string &key (:start integer) (:end integer))
|
|
local-time:timestamp)))
|
|
(defun parse-trashinfo-timestamp (line &key (start 0) (end (length line)))
|
|
"Pase a timestamp in the trashinfo file timestamp format."
|
|
(flet ((next-int (length)
|
|
(declare (type (integer 0) length))
|
|
(when (> 0 (- end start length))
|
|
(error 'parse-error))
|
|
(prog1 (parse-integer line :start start :end (+ start length))
|
|
(incf start length)))
|
|
(next-str (text)
|
|
(declare (type string text))
|
|
(when (> 0 (- end start (length text)))
|
|
(error 'parse-error))
|
|
(unless (string= line text :start1 start
|
|
:end1 (+ start (length text)))
|
|
(error 'parse-error))
|
|
(incf start (length text))))
|
|
(let (year month day hour minute second)
|
|
(setq year (next-int 4))
|
|
(next-str "-")
|
|
(setq month (next-int 2))
|
|
(next-str "-")
|
|
(setq day (next-int 2))
|
|
(next-str "T")
|
|
(setq hour (next-int 2))
|
|
(next-str ":")
|
|
(setq minute (next-int 2))
|
|
(next-str ":")
|
|
(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))
|
|
(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"
|
|
:directory '(:relative "info"))
|
|
trash-directory))
|
|
|
|
(declaim (ftype (function (pathname string stream &key (:source-file pathname))
|
|
trashinfo)
|
|
parse-trashinfo-from-stream))
|
|
(defun parse-trashinfo-from-stream
|
|
(trash-directory name in
|
|
&key (source-file (compute-trashinfo-source-file trash-directory name)))
|
|
"Parse the stream IN as a trashinfo file."
|
|
(let ((first-line (read-line in :eof-error-p nil)))
|
|
(unless first-line
|
|
(error 'trashinfo-format-error
|
|
:line-number 1 :source-file source-file
|
|
:context "" :message "Unexpected end-of-file"))
|
|
(unless (equal first-line "[Trash Info]")
|
|
(error 'trashinfo-format-error
|
|
:line-number 1 :source-file source-file
|
|
:context first-line
|
|
:message "First line should be \"[Trash Info]\"")))
|
|
(loop with path = nil
|
|
with deletion-date = nil
|
|
for line-number upfrom 2
|
|
for line = (read-line in nil)
|
|
while (and line (not (and path deletion-date)))
|
|
for delim = (position #\= line)
|
|
when delim
|
|
do (cond
|
|
((and (not path)
|
|
(string= line "Path" :end1 delim))
|
|
(setq path (url-decode line :start (1+ delim))))
|
|
((and (not deletion-date)
|
|
(string= line "DeletionDate" :end1 delim))
|
|
(handler-case
|
|
(setq deletion-date
|
|
(parse-trashinfo-timestamp line
|
|
:start (1+ delim)))
|
|
(parse-error ()
|
|
(error 'trashinfo-format-error
|
|
:line-number line-number :context line
|
|
:source-file source-file
|
|
:message "Invalid timestamp")))))
|
|
finally
|
|
(if (not (and path deletion-date))
|
|
(error 'trashinfo-format-error
|
|
:line-number line-number
|
|
:context "" :source-file source-file
|
|
:message
|
|
"End-of-file without both \"Path\" and \"DeletionDate\"")
|
|
(return (make-instance 'trashinfo
|
|
:deletion-date deletion-date
|
|
:path path :name name
|
|
:trash-directory trash-directory)))))
|
|
|
|
(declaim (ftype (function ((or pathname string) string) trashinfo)))
|
|
(defun parse-trashinfo-file
|
|
(trash-directory name
|
|
&key (source-file (compute-trashinfo-source-file trash-directory name)))
|
|
"Parse the trashinfo file NAME (which should not have an extension) in
|
|
TRASH-DIRECTORY. If SOURCE-FILE is not provided, it will be calculated."
|
|
(with-open-file (in source-file :if-does-not-exist :error)
|
|
(parse-trashinfo-from-stream trash-directory name in
|
|
:source-file source-file)))
|
|
|
|
(declaim (ftype (function (local-time:timestamp &optional
|
|
(or stream null (eql t)))
|
|
(or string null))
|
|
format-trashinfo-timestamp))
|
|
(defun format-trashinfo-timestamp (stamp &optional stream)
|
|
"Format STAMP for writing to a trashinfo file."
|
|
(format stream "~4,'0D-~2,'0D-~2,'0DT~2,'0D:~2,'0D:~2,'0D"
|
|
(local-time:timestamp-year stamp)
|
|
(local-time:timestamp-month stamp)
|
|
(local-time:timestamp-day stamp)
|
|
(local-time:timestamp-hour stamp)
|
|
(local-time:timestamp-minute stamp)
|
|
(local-time:timestamp-second stamp)))
|
|
|
|
(declaim (ftype (function (trashinfo &optional (or stream null (eql t)))
|
|
(or string null))
|
|
format-trashinfo))
|
|
(defun format-trashinfo (trashinfo &optional stream)
|
|
"Write the trashinfo file out to STREAM."
|
|
(with-slots (path deletion-date) trashinfo
|
|
(format stream "[Trash Info]~%Path=~A~%DeletionDate=~A~%"
|
|
(url-encode path :safe-chars '(#\/))
|
|
(format-trashinfo-timestamp deletion-date))))
|
|
|
|
(declaim (ftype (function (pathname (or string pathname)) stream)
|
|
open-trashinfo-for))
|
|
(defun open-trashinfo-for (trash-directory path)
|
|
(loop with trash-directory = (ensure-nonwild-pathname trash-directory
|
|
:ensure-directory t)
|
|
with name = (file-or-dir-namestring path)
|
|
with info-dir = (ensure-directories-exist
|
|
(merge-pathnames #P"info/"
|
|
(uiop:ensure-directory-pathname
|
|
trash-directory))
|
|
:verbose nil)
|
|
for info-file = (merge-pathnames
|
|
(make-pathname
|
|
:name (format nil "~A-~D"
|
|
name (random most-positive-fixnum))
|
|
:type "trashinfo")
|
|
info-dir)
|
|
for stream = (open info-file :direction :output
|
|
:if-exists nil
|
|
:if-does-not-exist :create)
|
|
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)
|
|
make-trashinfo-for))
|
|
(defun make-trashinfo-for (trash-directory path &optional (deletion-date
|
|
(local-time:now)))
|
|
"Generate a new name based off PATH and create a new trashinfo file under
|
|
TRASH-DIRECTORY. Return a trashinfo object pointing to this file."
|
|
(let* ((path (ensure-nonwild-pathname path))
|
|
(stream (open-trashinfo-for trash-directory path)))
|
|
(prog1
|
|
(handler-bind
|
|
((t #'(lambda (e)
|
|
(close stream :abort t)
|
|
(signal e))))
|
|
(let ((trashinfo
|
|
(make-instance 'trashinfo
|
|
:path (uiop:native-namestring
|
|
(merge-pathnames path (uiop:getcwd)))
|
|
:name (remove-suffix
|
|
(file-or-dir-namestring
|
|
(pathname stream))
|
|
".trashinfo")
|
|
:trash-directory trash-directory
|
|
:deletion-date deletion-date)))
|
|
(format-trashinfo trashinfo stream)
|
|
trashinfo))
|
|
;; if we exited successfully
|
|
(close stream))))
|
|
|
|
|
|
;; Local Variables:
|
|
;; jinx-local-words: "trashinfo"
|
|
;; End:
|