1 files changed, 20 insertions, 11 deletions
diff --git a/guix/build/syscalls.scm b/guix/build/syscalls.scm
index 48ff227e10..c663899160 100644
--- a/guix/build/syscalls.scm
+++ b/guix/build/syscalls.scm
@@ -64,6 +64,7 @@
 
             processes
             mkdtemp!
+            fdatasync
             pivot-root
             fcntl-flock
 
@@ -493,8 +494,7 @@ user-land process."
         <))
 
 (define mkdtemp!
-  (let* ((ptr  (dynamic-func "mkdtemp" (dynamic-link)))
-         (proc (pointer->procedure '* ptr '(*))))
+  (let ((proc (syscall->procedure '* "mkdtemp" '(*))))
     (lambda (tmpl)
       "Create a new unique directory in the file system using the template
 string TMPL and return its file name.  TMPL must end with 'XXXXXX'."
@@ -506,6 +506,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
@@ -611,8 +625,7 @@ are shared between the parent and child processes."
   ;; Some systems may be using an old (pre-2.14) version of glibc where there
   ;; is no 'setns' function available.
   (false-if-exception
-   (let* ((ptr  (dynamic-func "setns" (dynamic-link)))
-          (proc (pointer->procedure int ptr (list int int))))
+   (let ((proc (syscall->procedure int "setns" (list int int))))
      (lambda (fdes nstype)
        "Reassociate the current process with the namespace specified by FDES, a
 file descriptor obtained by opening a /proc/PID/ns/* file.  NSTYPE specifies
@@ -818,9 +831,7 @@ bytevector BV at INDEX."
 
 (define %ioctl
   ;; The most terrible interface, live from Scheme.
-  (pointer->procedure int
-                      (dynamic-func "ioctl" (dynamic-link))
-                      (list int unsigned-long '*)))
+  (syscall->procedure int "ioctl" (list int unsigned-long '*)))
 
 (define (bytevector->string-list bv stride len)
   "Return the null-terminated strings found in BV every STRIDE bytes.  Read at
@@ -1060,8 +1071,7 @@ return the list of resulting <interface> objects."
            (loop ptr (cons ifaddr result)))))))
 
 (define network-interfaces
-  (let* ((ptr  (dynamic-func "getifaddrs" (dynamic-link)))
-         (proc (pointer->procedure int ptr (list '*))))
+  (let ((proc (syscall->procedure int "getifaddrs" (list '*))))
     (lambda ()
       "Return a list of <interface> objects, each denoting a configured
 network interface.  This is implemented using the 'getifaddrs' libc function."
@@ -1078,8 +1088,7 @@ network interface.  This is implemented using the 'getifaddrs' libc function."
                    (list err)))))))
 
 (define free-ifaddrs
-  (let ((ptr (dynamic-func "freeifaddrs" (dynamic-link))))
-    (pointer->procedure void ptr '(*))))
+  (syscall->procedure void "freeifaddrs" '(*)))
 
 
 ;;;