First

Author: jsl

LICENSE

@@ -0,0 +1,20 @@
+Copyright (c) 2015 Justin Leitgeb
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

README.md

@@ -0,0 +1,22 @@
+# Atomic Write
+
+Atomic Write assists with atomic modification of files using
+Haskell. It is a wrapper for using the atomic mv(1) operation which
+correctly sets permissions based on the original file, or on system
+defaults if no file previously exists.
+
+See the
+[Haddock documentation](http://hackage.haskell.org/package/atomic-write)
+for more information.
+
+## Author
+
+Justin Leitgeb
+
+## License
+
+MIT
+
+## Copyright
+
+(C) 2015 [Stack Builders Inc.](http://www.stackbuilders.com/)

Setup.hs

@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain

atomic-write.cabal

@@ -0,0 +1,75 @@
+name:                atomic-write
+version:             0.1.0.0
+synopsis:            Atomically write to a file
+
+description:
+  .
+  Atomically write to a file on POSIX-compliant systems while preserving
+  permissions.
+  .
+  On most Unix systems, `mv` is an atomic operation. This makes it simple to write
+  to a file atomically just by using the mv operation. However, this will
+  destroy the permissions on the original file. This library does the following
+  to preserve permissions while atomically writing to a file:
+  .
+  * If an original file exists, take those permissions and apply them to the
+    temp file before `mv`ing the file into place.
+  * If the original file does not exist, create a following with default
+    permissions (based on the currently-active umask).
+  .
+  This way, when the file is `mv`'ed into place, the permissions will be the ones
+  held by the original file.
+  .
+  This library is based on similar implementations found in common libraries in
+  Ruby and Python:
+  .
+  * <http://apidock.com/rails/File/atomic_write/class Ruby on Rails includes a similar method called atomic_write>
+  * <https://github.com/chef/chef/blob/c4631816132fcfefaba3d123a1d0dfe8bc2866bb/lib/chef/file_content_management/deploy/mv_unix.rb#L23:L71 Chef includes atomic update functionality>
+  * <https://github.com/sashka/atomicfile There is a python library for atomically updating a file>
+  .
+  Note that at this time Windows is not supported, however we would appreciate
+  contributions to the <http://github.com/stackbuilders/atomic-write github repository>.
+license:             MIT
+license-file:        LICENSE
+author:              Justin Leitgeb
+maintainer:          [email protected]
+copyright:           2015 Stack Builders Inc.
+category:            System
+build-type:          Simple
+-- extra-source-files:
+cabal-version:       >=1.10
+
+library
+  exposed-modules:     System.AtomicWrite
+  -- other-modules:
+  -- other-extensions:
+  build-depends:         base >=4.5 && <4.8
+                       , temporary
+                       , unix
+                       , directory
+                       , filepath
+
+  hs-source-dirs:      src
+  default-language:    Haskell2010
+  ghc-options:         -Wall
+
+test-suite atomic-write-test
+  type: exitcode-stdio-1.0
+  hs-source-dirs: spec, src
+  main-is: Spec.hs
+
+  build-depends:       base >=4.5 && <4.8
+                     , temporary
+                     , unix
+                     , directory
+                     , filepath
+
+                     , hspec
+
+  default-language:    Haskell2010
+  ghc-options:         -Wall
+
+
+source-repository head
+  type:     git
+  location: https://github.com/stackbuilders/atomic-file

spec/Spec.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

spec/System/AtomicWriteSpec.hs

@@ -0,0 +1,81 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module System.AtomicWriteSpec (spec) where
+
+import Test.Hspec (it, describe, shouldBe, Spec)
+
+import System.AtomicWrite (atomicWriteFile)
+
+import System.IO.Temp (withSystemTempDirectory)
+import System.FilePath.Posix (joinPath)
+import System.Posix.Files
+  (setFileMode, setFileCreationMask, getFileStatus, fileMode)
+
+
+spec :: Spec
+spec = describe "atomicWriteFile" $ do
+    it "writes contents to a file" $
+      withSystemTempDirectory "atomicFileTest" $ \tmpDir -> do
+
+        let path = joinPath [ tmpDir, "writeTest.tmp" ]
+
+        atomicWriteFile path "just testing"
+
+        contents <- readFile path
+
+        contents `shouldBe` "just testing"
+
+
+    it "preserves the permissions of original file, regardless of umask" $
+      withSystemTempDirectory "atomicFileTest" $ \tmpDir -> do
+        let
+            filePath     = joinPath [tmpDir, "testFile"]
+
+        writeFile filePath "initial contents"
+        setFileMode filePath 0o100644
+
+        newStat <- getFileStatus filePath
+        fileMode newStat `shouldBe` 0o100644
+
+        -- New files are created with 100600 perms.
+        _ <- setFileCreationMask 0o100066
+
+        -- Create a new file once different mask is set and make sure that mask
+        -- is applied.
+        writeFile (joinPath [tmpDir, "sanityCheck"]) "with sanity check mask"
+        sanityCheckStat <- getFileStatus $ joinPath [tmpDir, "sanityCheck"]
+        fileMode sanityCheckStat `shouldBe` 0o100600
+
+        -- Since we move, this makes the new file assume the filemask of 0600
+        atomicWriteFile filePath "new contents"
+
+        resultStat <- getFileStatus filePath
+
+        -- Fails when using atomic mv command unless apply perms on initial file
+        fileMode resultStat `shouldBe` 0o100644
+
+
+    it "creates a new file with permissions based on active umask" $
+      withSystemTempDirectory "atomicFileTest" $ \tmpDir -> do
+        let
+          filePath       = joinPath [tmpDir, "testFile"]
+          sampleFilePath = joinPath [tmpDir, "sampleFile"]
+
+        -- Set somewhat distinctive defaults for test
+        _ <- setFileCreationMask 0o100171
+
+        -- We don't know what the default file permissions are, so create a
+        -- file to sample them.
+        writeFile sampleFilePath "I'm being written to sample permissions"
+
+        newStat <- getFileStatus sampleFilePath
+        fileMode newStat `shouldBe` 0o100606
+
+        atomicWriteFile filePath "new contents"
+
+        resultStat <- getFileStatus filePath
+
+        -- The default tempfile permissions are 0600, so this fails unless we
+        -- make sure that the default umask is relied on for creation of the
+        -- tempfile.
+        fileMode resultStat `shouldBe` 0o100606

src/System/AtomicWrite.hs

@@ -0,0 +1,63 @@
+-- |
+-- Module      : System.AtomicWrite
+-- Copyright   : (c) 2015 Stack Builders Inc.
+--
+-- License     : MIT
+-- Maintainer  : [email protected]
+-- Stability   : experimental
+-- Portability : GHC
+--
+-- A library for atomically modifying files while preserving permissions
+--
+
+module System.AtomicWrite (atomicWriteFile) where
+
+import System.Directory (renameFile, doesFileExist)
+import System.FilePath.Posix (takeDirectory)
+import System.IO
+  (Handle, openTempFile, openTempFileWithDefaultPermissions, hPutStr, hClose)
+
+import System.Posix.Files (setFileMode, getFileStatus, fileMode)
+
+
+-- | Creates a file atomically on POSIX-compliant systems while preserving
+-- permissions.
+atomicWriteFile ::
+  FilePath   -- ^ The path where the file will be updated or created
+  -> String  -- ^ The content to write to the file
+  -> IO ()
+atomicWriteFile f txt = do
+  (temppath, h) <- tempFileFor f
+
+  hPutStr h txt
+  hClose h
+
+  renameFile temppath f
+
+
+-- | Returns a temporary file with permissions correctly set.  chooses
+-- either previously-set permissions if the file that we're writing
+-- to existed, or permissions following the current umask.
+tempFileFor :: FilePath -> IO (FilePath, Handle)
+tempFileFor originalFilePath = do
+  let targetDirectory = takeDirectory originalFilePath
+
+  doesFileExist originalFilePath >>=
+    tmpFile originalFilePath targetDirectory "atomic.write"
+
+  where
+
+    tmpFile :: FilePath -> FilePath -> String -> Bool -> IO (FilePath, Handle)
+    tmpFile originalPath workingDirectory template previousExisted =
+
+      if previousExisted then do
+        (temppath, handle) <- openTempFile workingDirectory template
+
+        oldStat <- getFileStatus originalPath
+
+        setFileMode temppath $ fileMode oldStat
+
+        return (temppath, handle)
+
+      else
+        openTempFileWithDefaultPermissions workingDirectory template