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'.
This commit is contained in:
parent
9f8ee3fe0e
commit
1752a17a1e
|
@ -64,6 +64,7 @@
|
||||||
|
|
||||||
processes
|
processes
|
||||||
mkdtemp!
|
mkdtemp!
|
||||||
|
fdatasync
|
||||||
pivot-root
|
pivot-root
|
||||||
fcntl-flock
|
fcntl-flock
|
||||||
|
|
||||||
|
@ -506,6 +507,20 @@ string TMPL and return its file name. TMPL must end with 'XXXXXX'."
|
||||||
(list err)))
|
(list err)))
|
||||||
(pointer->string result)))))
|
(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>
|
(define-record-type <file-system>
|
||||||
(file-system type block-size blocks blocks-free
|
(file-system type block-size blocks blocks-free
|
||||||
|
|
|
@ -34,7 +34,7 @@
|
||||||
#:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
|
#:use-module ((rnrs bytevectors) #:select (bytevector-u8-set!))
|
||||||
#:use-module (guix combinators)
|
#:use-module (guix combinators)
|
||||||
#:use-module ((guix build utils) #:select (dump-port))
|
#: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 vlist)
|
||||||
#:use-module (ice-9 format)
|
#:use-module (ice-9 format)
|
||||||
#:autoload (ice-9 popen) (open-pipe*)
|
#:autoload (ice-9 popen) (open-pipe*)
|
||||||
|
@ -625,7 +625,8 @@ output port, and PROC's result is returned."
|
||||||
(with-throw-handler #t
|
(with-throw-handler #t
|
||||||
(lambda ()
|
(lambda ()
|
||||||
(let ((result (proc out)))
|
(let ((result (proc out)))
|
||||||
(close out)
|
(fdatasync out)
|
||||||
|
(close-port out)
|
||||||
(rename-file template file)
|
(rename-file template file)
|
||||||
result))
|
result))
|
||||||
(lambda (key . args)
|
(lambda (key . args)
|
||||||
|
|
Loading…
Reference in New Issue