Improve error output

cl-xdg-trash/trash.lisp

@@ -35,6 +35,38 @@
                      (uiop:native-namestring (file-error-pathname condition)))))
   (:documentation "An error representing the case that a file already exists."))
 
+(define-condition file-not-found-error (file-error)
+  ()
+  (:report (lambda (condition stream)
+             (format stream "No such file or directory: ~S"
+                     (uiop:native-namestring (file-error-pathname condition)))))
+  (:documentation "An error representing the case that a file does not exist."))
+
+(define-condition two-arg-file-error (file-error)
+  ((action :accessor two-arg-file-error-action
+           :type string
+           :initarg :action
+           :documentation "The action that caused the problem.")
+   (detail :accessor two-arg-file-error-detail
+           :type (or string null)
+           :initarg :detail
+           :initform nil
+           :documentation "A specific error message (e.g. Permission denied).")
+   (target :accessor two-arg-file-error-target
+           :type (or string pathname null)
+           :initarg :target
+           :initform nil
+           :documentation "The optional target of the action."))
+  (:report (lambda (condition stream)
+             (let ((target (two-arg-file-error-target condition)))
+               (format stream "Cannot ~A ~S~@[ to ~S~]~@[: ~A~]"
+                       (two-arg-file-error-action condition)
+                       (uiop:native-namestring (file-error-pathname condition))
+                       (and target (uiop:native-namestring target))
+                       (two-arg-file-error-detail condition)))))
+  (:documentation
+   "An error that occurred during a two-file operation (rename, etc.)."))
+
 (declaim (ftype (function (&key (:homedir (or pathname string null))) pathname)
                 xdg-data-home))
 (defun xdg-data-home (&key homedir)
@@ -196,20 +228,60 @@ ROOT. IGNORED-TRASH-DIRS must be directory paths that are not wild!"
     ;; two operations atomically, so we settle for this
     (when (probe-file target)
       (error 'file-exists-error :pathname target))
+    (handler-case
         (osicat-posix:rename (uiop:native-namestring source)
-                         (uiop:native-namestring target))))
+                             (uiop:native-namestring target))
+      (osicat-posix:enoent ()
+        (error 'file-not-found-error :pathname source))
+      (osicat-posix:eacces ()
+        (error 'two-arg-file-error :action "rename"
+                                   :detail "Permission denied"
+                                   :pathname source
+                                   :target target)))))
+
+(declaim (ftype (function (integer integer &key (:buffer-size integer)) integer)
+                copy-file-descriptor))
+(defun copy-file-descriptor (in out &key (buffer-size 8192))
+  "Copy all data from the file descriptor IN to OUT."
+  (let (buffer)
+    (unwind-protect
+         (progn
+           (setq buffer (cffi:foreign-alloc :char :count buffer-size))
+           (loop for read = (osicat-posix:read in buffer buffer-size)
+                 while (plusp read)
+                 do (osicat-posix:write out buffer read)
+                 sum read))
+      (when buffer
+        (cffi:foreign-free buffer)))))
 
 (declaim (ftype (function ((or pathname string) (or pathname string)) t)
                 copy-file))
 (defun copy-file (source target)
   "Copy the normal file SOURCE to TARGET. Error if TARGET already exists."
-  (with-open-file (in (ensure-nonwild-pathname source)
+  (handler-case
-                      :direction :input
+      (let ((source (ensure-nonwild-pathname source))
-                      :if-does-not-exist :error)
+            (target (ensure-nonwild-pathname target))
-    (with-open-file (out (ensure-nonwild-pathname target)
+            in out)
-                         :direction :output
+        (unwind-protect
-                         :if-exists :error)
+             (progn
-      (uiop:copy-stream-to-stream in out))))
+               (setq in (osicat-posix:open
+                         (uiop:native-namestring source)
+                         osicat-posix:o-rdonly)
+                     out (osicat-posix:open
+                          (uiop:native-namestring target)
+                          (logior osicat-posix:o-wronly osicat-posix:o-creat)))
+               (copy-file-descriptor in out))
+          (when in
+            (osicat-posix:close in))
+          (when out
+            (osicat-posix:close out))))
+    (osicat-posix:enoent ()
+      (error 'file-not-found-error :pathname source))
+    (osicat-posix:eacces ()
+      (error 'two-arg-file-error :action "copy"
+                                 :detail "Permission denied"
+                                 :pathname source
+                                 :target target))))
 
 (declaim (ftype (function ((or string pathname)
                            (or string pathname)