syscall: Don't require (function ...) for the name argument.

[lisp] / safely.lisp

diff --git a/safely.lisp b/safely.lisp
index 6153060e26fdac6f2a7863fcc732784d2994a000..c78492a95851ad97fb4c168e4843467271a2baf8 100644 (file)
--- a/safely.lisp
+++ b/safely.lisp
@@ -34,12 +34,15 @@ (defstruct (safely (:predicate safelyp))
   "Stores information about how to commit or undo safe writes."
   (streams nil)
   (trail nil))
   "Stores information about how to commit or undo safe writes."
   (streams nil)
   (trail nil))

+

 (defun safely-close (safe stream)
   "Make sure that STREAM is closed when SAFE is finished."
   (push stream (safely-streams safe)))
 (defun safely-close (safe stream)
   "Make sure that STREAM is closed when SAFE is finished."
   (push stream (safely-streams safe)))

+

 (defun safely-delete-file (safe file)
   "Delete FILE when SAFE is committed."
   (push `(:delete ,file ,(fresh-file-name file "del")) (safely-trail safe)))
 (defun safely-delete-file (safe file)
   "Delete FILE when SAFE is committed."
   (push `(:delete ,file ,(fresh-file-name file "del")) (safely-trail safe)))

+

 (defun fresh-file-name (base tag)
   "Return a fresh file name constructed from BASE and TAG in the current
 directory.  Do not assume that this filename will be good by the time you try
 (defun fresh-file-name (base tag)
   "Return a fresh file name constructed from BASE and TAG in the current
 directory.  Do not assume that this filename will be good by the time you try


@@ -47,6 +50,7 @@ (defun fresh-file-name (base tag)
   (let ((name (format nil "~A.~A-~X"
                      base tag (random most-positive-fixnum))))
     (if (probe-file name) (fresh-file-name base tag) name)))
   (let ((name (format nil "~A.~A-~X"
                      base tag (random most-positive-fixnum))))
     (if (probe-file name) (fresh-file-name base tag) name)))

+

 (defun safely-open-output-stream (safe file &rest open-args)
   "Create an output stream which will be named FILE when SAFE is committed.
 Other OPEN-ARGS are passed to open."
 (defun safely-open-output-stream (safe file &rest open-args)
   "Create an output stream which will be named FILE when SAFE is committed.
 Other OPEN-ARGS are passed to open."


@@ -60,15 +64,20 @@ (defun safely-open-output-stream (safe file &rest open-args)
     (push `(:shunt ,new ,file ,(fresh-file-name file "old"))
          (safely-trail safe))
     stream))
     (push `(:shunt ,new ,file ,(fresh-file-name file "old"))
          (safely-trail safe))
     stream))

+

 (defun delete-file-without-moaning (file)
   "Delete the FILE, ignoring errors."
 (defun delete-file-without-moaning (file)
   "Delete the FILE, ignoring errors."

-  (when (probe-file file)
-    (unix-try unlink file)))
+  (with-errno-handlers ()
+      (sys-unlink file)
+    (ENOENT nil)))
+

 (defun rename-file-without-moaning (old new)
   "Rename OLD to NEW, ignoring errors, and without doing any stupid name
 mangling."
 (defun rename-file-without-moaning (old new)
   "Rename OLD to NEW, ignoring errors, and without doing any stupid name
 mangling."

-  (when (probe-file old)
-    (unix-try rename old new)))
+  (with-errno-handlers ()
+      (sys-rename old new)
+    (ENOENT nil)))
+

 (defun safely-unwind (trail)
   "Roll back the TRAIL of operations."
   (dolist (job trail)
 (defun safely-unwind (trail)
   "Roll back the TRAIL of operations."
   (dolist (job trail)


@@ -84,10 +93,12 @@ (defun safely-unwind (trail)
       (:revert (destructuring-bind (tag old new) job
                 (declare (ignore tag))
                 (rename-file-without-moaning old new))))))
       (:revert (destructuring-bind (tag old new) job
                 (declare (ignore tag))
                 (rename-file-without-moaning old new))))))

+

 (defun safely-reset (safe)
   "Reset SAFE to its initial state."
   (setf (safely-streams safe) nil)
   (setf (safely-trail safe) nil))
 (defun safely-reset (safe)
   "Reset SAFE to its initial state."
   (setf (safely-streams safe) nil)
   (setf (safely-trail safe) nil))

+

 (defun safely-bail (safe)
   "Abort the operations in SAFE, unwinding all the things that have been
 done.  Streams are closed, new files are removed."
 (defun safely-bail (safe)
   "Abort the operations in SAFE, unwinding all the things that have been
 done.  Streams are closed, new files are removed."


@@ -95,6 +106,7 @@ (defun safely-bail (safe)
     (close stream :abort t))
   (safely-unwind (safely-trail safe))
   (safely-reset safe))
     (close stream :abort t))
   (safely-unwind (safely-trail safe))
   (safely-reset safe))

+

 (defun safely-commit (safe)
   "Commit SAFE.  The files deleted by safely-delete-file are deleted; the
 files created by safely-open-output-stream are renamed over the old versions,
 (defun safely-commit (safe)
   "Commit SAFE.  The files deleted by safely-delete-file are deleted; the
 files created by safely-open-output-stream are renamed over the old versions,


@@ -121,17 +133,18 @@ (defun safely-commit (safe)
                                  (copy-file file old)
                                  (push `(:revert ,old ,file) revert))
                                (push `(:rmtmp ,file) revert))
                                  (copy-file file old)
                                  (push `(:revert ,old ,file) revert))
                                (push `(:rmtmp ,file) revert))

-                           (unix-try rename new file)))
+                           (sys-rename new file)))

                  (:delete (destructuring-bind (tag file old) job
                             (declare (ignore tag))
                             (push `(:revert ,old ,file) revert)
                  (:delete (destructuring-bind (tag file old) job
                             (declare (ignore tag))
                             (push `(:revert ,old ,file) revert)

-                            (unix-try rename file old)
+                            (sys-rename file old)

                             (push `(:rmtmp old) cleanup))))))
          (setf revert nil))
       (safely-unwind trail)
       (safely-unwind revert)
       (safely-unwind cleanup)
       (safely-reset safe))))
                             (push `(:rmtmp old) cleanup))))))
          (setf revert nil))
       (safely-unwind trail)
       (safely-unwind revert)
       (safely-unwind cleanup)
       (safely-reset safe))))

+

 (defmacro safely ((safe &key) &body body)
   "Do stuff within the BODY safely.  If BODY completes without errors, the
 SAFE is committed; otherwise it's bailed."
 (defmacro safely ((safe &key) &body body)
   "Do stuff within the BODY safely.  If BODY completes without errors, the
 SAFE is committed; otherwise it's bailed."


@@ -143,6 +156,7 @@ (defmacro safely ((safe &key) &body body)
           (setf ,safe nil))
        (when ,safe
         (safely-bail ,safe)))))
           (setf ,safe nil))
        (when ,safe
         (safely-bail ,safe)))))

+

 (defmacro safely-writing ((stream file &rest open-args) &body body)
   "Simple macro for writing a single file safely.  STREAM is opened onto a
 temporary file, and if BODY completes, it is renamed to FILE."
 (defmacro safely-writing ((stream file &rest open-args) &body body)
   "Simple macro for writing a single file safely.  STREAM is opened onto a
 temporary file, and if BODY completes, it is renamed to FILE."