diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm index 48ff227e10..ed0eb060d9 100644 --- a/guix/build/syscalls.scm +++ b/guix/build/syscalls.scm @@ -64,6 +64,7 @@ (define-module (guix build syscalls) processes mkdtemp! + fdatasync pivot-root fcntl-flock @@ -506,6 +507,20 @@ (define mkdtemp! (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 type block-size blocks blocks-free diff --git a/guix/utils.scm b/guix/utils.scm index c77da5d846..18d913c514 100644 --- a/guix/utils.scm +++ b/guix/utils.scm @@ -34,7 +34,7 @@ (define-module (guix utils) #: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 @@ (define (with-atomic-file-output file proc) (with-throw-handler #t (lambda () (let ((result (proc out))) - (close out) + (fdatasync out) + (close-port out) (rename-file template file) result)) (lambda (key . args)