diff options
Diffstat (limited to 'module/util/io.scm')
| -rw-r--r-- | module/util/io.scm | 36 |
1 files changed, 36 insertions, 0 deletions
diff --git a/module/util/io.scm b/module/util/io.scm index a9da7ea6..1652f042 100644 --- a/module/util/io.scm +++ b/module/util/io.scm @@ -19,3 +19,39 @@ (let loop ((line (read-line))) (if (eof-object? line) '() (cons line (loop (read-line)))))))) + +;; Same functionality as the regular @var{with-output-to-file}, but +;; with the difference that either everything is written, or nothing +;; is written, and if anything is written it's all written atomicaly at +;; once (the original file will never contain an intermidiate state). +;; Does NOT handle race conditions between threads. +;; Return #f on failure, something truthy otherwise +(define-public (with-atomic-output-to-file filename thunk) + ;; copy to enusre writable string + (define tmpfile (string-copy (string-append + (dirname filename) + file-name-separator-string + "." (basename filename) + "XXXXXX"))) + (define port #f) + (dynamic-wind + (lambda () (set! port (mkstemp! tmpfile))) + (lambda () + (with-output-to-port port thunk) + ;; (force-output port) + ;; TODO check buffereing, might throw exception? + (close-port port) + (rename-file tmpfile filename)) + (lambda () + ;; (force-output port) + ;; TODO check buffereing, might throw exception? + ;; tmpfile still existing means that we never hit the + ;; rename above, clean up the file and note that we failed. + (when (access? tmpfile F_OK) + (close-port port) + (delete-file tmpfile) + ;; `when' defaults to the truthy `()', see (util) + ;; (note that #<unspecified> is thruthy, but shouldn't be + ;; counted on, since anything with an unspecified return + ;; value might as well return #f) + #f)))) |