Zander671/cl-xdg-trash
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Finish trashinfo.lisp

Browse Source
This commit is contained in:
Alexander Rosenberg
2025-10-01 00:40:15 -07:00
parent 5ba78e2760
commit 092b0993e7
3 changed files with 170 additions and 37 deletions
Download Patch File Download Diff File Expand all files Collapse all files

18
package.lisp
View File

@ -11,4 +11,20 @@
(:documentation
"Parser and utility functions for dealing with .trashinfo files.")
(:use :cl)
(:export))
(:import-from #:cl-xdg-trash/url-encode
#:url-encode
#:url-decode)
(:export #:trashinfo-format-error
#:trashinfo-format-error-message
#:trashinfo-format-error-line-numer
#:trashinfo-format-error-context
#:trashinfo-format-error-source-file
#:trashinfo
#:trashinfo-trash-directory
#:trashinfo-name
#:trashinfo-path
#:trashinfo-deletion-date
#:trashinfo-trashed-file
#:parse-trashinfo-from-stream
#:parse-trashinfo-file
#:format-trashinfo))

158
trashinfo.lisp
View File

@ -1,6 +1,6 @@
(in-package :cl-xdg-trash/trashinfo)
(define-condition trashinfo-format-error (error)
(define-condition trashinfo-format-error (parse-error)
((message :accessor trashinfo-format-error-message
:initarg :message
:type string
@ -29,44 +29,150 @@ line 1.")
:type pathname
:documentation "The path to the trash directory that this
trashinfo file belongs to.")
(name :accessor trashinfo-name
(name :reader trashinfo-name
:initarg :name
:type string
:documentation "The name of this trashinfo file without the extension.")
(path :accessor trashinfo-path
(path :reader trashinfo-path
:initarg :path
:type pathname
:documentation "Path to the original location of the file.")
(deletion-date :accessor trashinfo-deletion-date
(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."))
(declaim (ftype (function ((or pathname string) string) trashinfo)))
(defun parse-trashinfo-from-string (trash-directory name)
"Parse the trashinfo file NAME (which should not have an extension) in
TRASH-DIRECTORY."
(let ((source-file (merge-pathnames (make-pathname :name name
:directory '(:relative "info"))
trash-directory)))
(with-open-file (in source-file :if-does-not-exist :error)
(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 for line = (read-line in :eof-error-p nil)
while line)
)))
(defmethod trashinfo-trashed-file ((trashinfo trashinfo))
(with-slots (name trash-directory) trashinfo
(merge-pathnames (make-pathname :name name :directory '(:relative "files"))
trash-directory)))
(defmethod trashinfo-trashed-file ())
(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))))
;; Local Variables:

31
url-encode.lisp
View File

@ -11,7 +11,9 @@
(or (and (>= code (char-code #\a))
(<= code (char-code #\z)))
(and (>= code (char-code #\A))
(<= code (char-code #\Z)))))))
(<= code (char-code #\Z)))
(and (>= code (char-code #\0))
(<= code (char-code #\9)))))))
(deftype utf-8-code-point ()
'(integer 0 #x10FFFF))
@ -73,17 +75,26 @@ represent."
;; 1 byte
(t part1)))))
(declaim (ftype (function (character) string) escape-char-for-url))
(defun escape-char-for-url (char)
(declaim (ftype (function (character &key (:safe-chars list)) list)
escape-char-for-url))
(defun escape-char-for-url (char &key safe-chars)
"Escape CHAR such that it is safe to include in a URL."
(if (url-unreserved-character-p char)
(string char)
(format nil "~{%~X~}" (utf-8-encode-char char))))
(if (or (url-unreserved-character-p char) (member char safe-chars
:test #'eql))
(list char)
(coerce (format nil "~{%~X~}" (utf-8-encode-char char)) 'list)))
(declaim (ftype (function (string) string) url-encode))
(defun url-encode (string)
"URL encode (percent escape) STRING."
(format nil "~{~A~}" (map 'list 'escape-char-for-url string)))
(declaim (ftype (function (string &key (:start integer) (:end integer)
(:safe-chars list))
string)
url-encode))
(defun url-encode (string &key (start 0) (end (length string)) safe-chars)
"URL encode (percent escape) STRING. SAFE-CHARS is a list of characters that
should not be encoded."
(coerce (loop for i upfrom start below end
for char = (aref string i)
append (escape-char-for-url char :safe-chars safe-chars))
'string))
(define-condition url-decode-error (error)
((string :accessor url-decode-error-string