01/05: utils: 'with-atomic-file-output' calls 'fdatasync'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 1752a17a1e6f7138892eeeb4806cd04ccb3ca1b0
Author: Ludovic Courtès <address@hidden>
Date:   Mon Jun 13 17:52:08 2016 +0200

    utils: 'with-atomic-file-output' calls 'fdatasync'.
    
    Suggested by Danny Milosavljevic <address@hidden>
    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'.
---
 guix/build/syscalls.scm |   15 +++++++++++++++
 guix/utils.scm          |    5 +++--
 2 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 48ff227..ed0eb06 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -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
diff --git a/guix/utils.scm b/guix/utils.scm
index c77da5d..18d913c 100644
--- a/guix/utils.scm
+++ b/guix/utils.scm
@@ -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)