[dmd] 02/05: Write the PID file atomically.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository dmd.

commit 69d2574b73f4b7f00e832ff63dd27e94634d5945
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jan 8 23:05:01 2016 +0100

    Write the PID file atomically.
    
    * modules/dmd/support.scm (with-atomic-file-output): New file.
    * modules/dmd.scm (main): Use it.
---
 modules/dmd.scm         |    6 +++---
 modules/dmd/support.scm |   17 +++++++++++++++++
 2 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/modules/dmd.scm b/modules/dmd.scm
index 0d5fbda..889c09f 100644
--- a/modules/dmd.scm
+++ b/modules/dmd.scm
@@ -1,6 +1,6 @@
 ;; dmd.scm -- Daemon managing Daemons (or Daemons-managing Daemon?)
-;; Copyright (C) 2013, 2014 Ludovic Court�s <address@hidden>
-;; Copyright (C) 2002, 2003 Wolfgang J�hrling <address@hidden>
+;; Copyright (C) 2013, 2014, 2016 Ludovic Courtès <address@hidden>
+;; Copyright (C) 2002, 2003 Wolfgang Jährling <address@hidden>
 ;;
 ;; This file is part of GNU dmd.
 ;;
@@ -194,7 +194,7 @@
           ;; connections.  XXX: What if we daemonized already?
           (match pid-file
             ((? string? file)
-             (call-with-output-file pid-file
+             (with-atomic-file-output pid-file
                (cute display (getpid) <>)))
             (#t (display (getpid)))
             (_  #t))
diff --git a/modules/dmd/support.scm b/modules/dmd/support.scm
index d13d260..dd42186 100644
--- a/modules/dmd/support.scm
+++ b/modules/dmd/support.scm
@@ -31,6 +31,8 @@
             catch-system-error
             with-system-error-handling
             EINTR-safe
+            with-atomic-file-output
+
             l10n
             local-output
             display-version
@@ -148,6 +150,21 @@ was possible up to Guile 2.0.9 included) the call to PROC 
is restarted."
               (loop)
               (apply throw args)))))))
 
+(define (with-atomic-file-output file proc)       ;copied from Guix
+  "Call PROC with an output port for the file that is going to replace FILE.
+Upon success, FILE is atomically replaced by what has been written to the
+output port, and PROC's result is returned."
+  (let* ((template (string-append file ".XXXXXX"))
+         (out      (mkstemp! template)))
+    (with-throw-handler #t
+      (lambda ()
+        (let ((result (proc out)))
+          (close out)
+          (rename-file template file)
+          result))
+      (lambda (key . args)
+        (catch-system-error (delete-file template))))))
+
 
 
 ;; Localized version of STR.