diff --git a/package.lisp b/package.lisp index 84453d2..cf097f1 100644 --- a/package.lisp +++ b/package.lisp @@ -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)) diff --git a/trashinfo.lisp b/trashinfo.lisp index 8183260..be50c75 100644 --- a/trashinfo.lisp +++ b/trashinfo.lisp @@ -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: diff --git a/url-encode.lisp b/url-encode.lisp index d11aa2e..758b0c6 100644 --- a/url-encode.lisp +++ b/url-encode.lisp @@ -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