utils: 'with-atomic-file-output' calls 'fdatasync'.
Suggested by Danny Milosavljevic <dannym@scratchpost.org> at <https://lists.gnu.org/archive/html/guix-devel/2016-06/msg00456.html>. * guix/build/syscalls.scm (fdatasync): New procedure. * guix/utils.scm (with-atomic-file-output): Use it. Use 'close-port' instead of 'close'.master
parent
9f8ee3fe0e
commit
1752a17a1e
|
@ -64,6 +64,7 @@
|
|||
|
||||
processes
|
||||
mkdtemp!
|
||||
fdatasync
|
||||
pivot-root
|
||||
fcntl-flock
|
||||
|
||||
|
@ -506,6 +507,20 @@ string TMPL and return its file name. TMPL must end with 'XXXXXX'."
|
|||
(list err)))
|
||||
(pointer->string result)))))
|
||||
|
||||
(define fdatasync
|
||||
(let ((proc (syscall->procedure int "fdatasync" (list int))))
|
||||
(lambda (port)
|
||||
"Flush buffered output of PORT, an output file port, and then call
|
||||
fdatasync(2) on the underlying file descriptor."
|
||||
(force-output port)
|
||||
(let* ((fd (fileno port))
|
||||
(ret (proc fd))
|
||||
(err (errno)))
|
||||
(unless (zero? ret)
|
||||
(throw 'system-error "fdatasync" "~S: ~A"
|
||||
(list fd (strerror err))
|
||||
(list err)))))))
|
||||
|
||||
|
||||
(define-record-type <file-system>
|
||||
(file-system type block-size blocks blocks-free
|
||||
|
|
|
@ -34,7 +34,7 @@
|
|||
#:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
|
||||
#:use-module (guix combinators)
|
||||
#:use-module ((guix build utils) #:select (dump-port))
|
||||
#:use-module ((guix build syscalls) #:select (mkdtemp!))
|
||||
#:use-module ((guix build syscalls) #:select (mkdtemp! fdatasync))
|
||||
#:use-module (ice-9 vlist)
|
||||
#:use-module (ice-9 format)
|
||||
#:autoload (ice-9 popen) (open-pipe*)
|
||||
|
@ -625,7 +625,8 @@ output port, and PROC's result is returned."
|
|||
(with-throw-handler #t
|
||||
(lambda ()
|
||||
(let ((result (proc out)))
|
||||
(close out)
|
||||
(fdatasync out)
|
||||
(close-port out)
|
||||
(rename-file template file)
|
||||
result))
|
||||
(lambda (key . args)
|
||||
|
|
Reference in New Issue