Windows: make openTempFile fully atomic.

2 files changed, 47 insertions, 29 deletions

diff --git a/libraries/base/cbits/Win32Utils.c b/libraries/base/cbits/Win32Utils.c
index b33db04c35..886c277b5c 100644
--- a/libraries/base/cbits/Win32Utils.c
+++ b/libraries/base/cbits/Win32Utils.c
@@ -158,39 +158,55 @@ bool getTempFileNameErrorNo (wchar_t* pathName, wchar_t* prefix,
                              wchar_t* suffix, uint32_t uUnique,
                              wchar_t* tempFileName)
 {
-  if (!GetTempFileNameW(pathName, prefix, uUnique, tempFileName))
+  int retry = 5;
+  bool success = false;
+  while (retry > 0 && !success)
     {
-      maperrno();
-      return false;
-    }
-
-  wchar_t* drive = malloc (sizeof(wchar_t) * _MAX_DRIVE);
-  wchar_t* dir   = malloc (sizeof(wchar_t) * _MAX_DIR);
-  wchar_t* fname = malloc (sizeof(wchar_t) * _MAX_FNAME);
-  bool success = true;
-  if (_wsplitpath_s (tempFileName, drive, _MAX_DRIVE, dir, _MAX_DIR,
-                     fname, _MAX_FNAME, NULL, 0) != 0)
-    {
-      success = false;
-      maperrno ();
-    }
-  else
-    {
-      wchar_t* temp = _wcsdup (tempFileName);
-      if (wcsnlen(drive, _MAX_DRIVE) == 0)
-        swprintf_s(tempFileName, MAX_PATH, L"%s\%s%s",
-                   dir, fname, suffix);
+      // TODO: This needs to handle long file names.
+      if (!GetTempFileNameW(pathName, prefix, uUnique, tempFileName))
+        {
+          maperrno();
+          return false;
+        }
+
+      wchar_t* drive = malloc (sizeof(wchar_t) * _MAX_DRIVE);
+      wchar_t* dir   = malloc (sizeof(wchar_t) * _MAX_DIR);
+      wchar_t* fname = malloc (sizeof(wchar_t) * _MAX_FNAME);
+      if (_wsplitpath_s (tempFileName, drive, _MAX_DRIVE, dir, _MAX_DIR,
+                        fname, _MAX_FNAME, NULL, 0) != 0)
+        {
+          success = false;
+          maperrno ();
+        }
       else
-        swprintf_s(tempFileName, MAX_PATH, L"%s\%s\%s%s",
-                   drive, dir, fname, suffix);
-      MoveFileW(temp, tempFileName);
-      free(temp);
+        {
+          wchar_t* temp = _wcsdup (tempFileName);
+          if (wcsnlen(drive, _MAX_DRIVE) == 0)
+            swprintf_s(tempFileName, MAX_PATH, L"%s\%s%s",
+                      dir, fname, suffix);
+          else
+            swprintf_s(tempFileName, MAX_PATH, L"%s\%s\%s%s",
+                      drive, dir, fname, suffix);
+          success
+             = MoveFileExW(temp, tempFileName, MOVEFILE_WRITE_THROUGH
+                                               | MOVEFILE_COPY_ALLOWED) != 0;
+          errno = 0;
+          if (!success && (GetLastError () != ERROR_FILE_EXISTS || --retry < 0))
+            {
+              success = false;
+              maperrno ();
+              DeleteFileW (temp);
+            }
+
+
+          free(temp);
+        }
+
+      free(drive);
+      free(dir);
+      free(fname);
     }
 
-  free(drive);
-  free(dir);
-  free(fname);
-
   return success;
 }
 #endif
diff --git a/libraries/base/changelog.md b/libraries/base/changelog.md
index a83c2d55a7..e404442801 100644
--- a/libraries/base/changelog.md
+++ b/libraries/base/changelog.md
@@ -28,6 +28,8 @@
   * Add `Functor`, `Applicative`, `Monad`, `Alternative`, `MonadPlus`,
     `Generic` and `Generic1` instances to `Kleisli`
 
+  * `openTempFile` is now fully atomic and thread-safe on Windows.
+
 ## 4.13.0.0 *TBA*
   * Bundled with GHC *TBA*