Finish trashinfo.lisp

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

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,29 +29,73 @@ 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)))
+(defmethod trashinfo-trashed-file ((trashinfo trashinfo))
-(defun parse-trashinfo-from-string (trash-directory name)
+  (with-slots (name trash-directory) trashinfo
-  "Parse the trashinfo file NAME (which should not have an extension) in
+    (merge-pathnames (make-pathname :name name :directory '(:relative "files"))
-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)
+
+(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
@@ -62,11 +106,73 @@ TRASH-DIRECTORY."
              :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)
+  (loop with path = nil
-            while line)
+        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)))))
 
-(defmethod trashinfo-trashed-file ())
+(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:

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))
+(declaim (ftype (function (character &key (:safe-chars list)) list)
-(defun escape-char-for-url (char)
+                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)
+  (if (or (url-unreserved-character-p char) (member char safe-chars
-      (string char)
+                                                    :test #'eql))
-      (format nil "~{%~X~}" (utf-8-encode-char char))))
+      (list char)
+      (coerce (format nil "~{%~X~}" (utf-8-encode-char char)) 'list)))
 
-(declaim (ftype (function (string) string) url-encode))
+(declaim (ftype (function (string &key (:start integer) (:end integer)
-(defun url-encode (string)
+                                  (:safe-chars list))
-  "URL encode (percent escape) STRING."
+                          string)
-  (format nil "~{~A~}" (map 'list 'escape-char-for-url 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