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:
Ludovic Courtès 2016-06-13 17:52:08 +02:00
parent 9f8ee3fe0e
commit 1752a17a1e
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
2 changed files with 18 additions and 2 deletions

View File

@ -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

View File

@ -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)