Commit 5f6515b6 authored by Petr Pudlak's avatar Petr Pudlak

A separate module for functions for atomic file operations

Utils is getting too big, so better split this new set of functions into
a separate sub-module. This also allows us to use ResultG there.
Signed-off-by: default avatarPetr Pudlak <pudlak@google.com>
Reviewed-by: default avatarKlaus Aehlig <aehlig@google.com>
parent 0efada2a
......@@ -135,6 +135,7 @@ HS_DIRS = \
src/Ganeti/Storage/Drbd \
src/Ganeti/Storage/Lvm \
src/Ganeti/THH \
src/Ganeti/Utils \
src/Ganeti/WConfd \
test/hs \
test/hs/Test \
......@@ -803,6 +804,7 @@ HS_LIB_SRCS = \
src/Ganeti/Types.hs \
src/Ganeti/UDSServer.hs \
src/Ganeti/Utils.hs \
src/Ganeti/Utils/Atomic.hs \
src/Ganeti/VCluster.hs \
src/Ganeti/WConfd/ConfigState.hs \
src/Ganeti/WConfd/Core.hs \
......
......@@ -103,6 +103,7 @@ import Ganeti.Rpc (executeRpcCall, ERpcError, logRpcErrors,
import Ganeti.THH
import Ganeti.Types
import Ganeti.Utils
import Ganeti.Utils.Atomic
import Ganeti.VCluster (makeVirtualPath)
-- * Data types
......
......@@ -65,13 +65,8 @@ module Ganeti.Utils
, setOwnerAndGroupFromNames
, setOwnerWGroupR
, formatOrdinal
, atomicWriteFile
, atomicUpdateFile
, atomicUpdateLockedFile
, atomicUpdateLockedFile_
, tryAndLogIOError
, lockFile
, withLockedFile
, FStat
, nullFStat
, getFStat
......@@ -85,11 +80,8 @@ module Ganeti.Utils
import Control.Concurrent
import Control.Exception (try)
import qualified Control.Exception.Lifted as L
import Control.Monad
import Control.Monad.Base (MonadBase(..))
import Control.Monad.Error
import Control.Monad.Trans.Control
import Data.Char (toUpper, isAlphaNum, isDigit, isSpace)
import qualified Data.Either as E
import Data.Function (on)
......@@ -98,7 +90,7 @@ import Data.List
import qualified Data.Map as M
import Numeric (showOct)
import System.Directory (renameFile, createDirectoryIfMissing)
import System.FilePath.Posix (takeDirectory, takeBaseName)
import System.FilePath.Posix (takeDirectory)
import System.INotify
import System.Posix.Types
......@@ -559,75 +551,6 @@ formatOrdinal num
where tens = num `mod` 10
suffix s = show num ++ s
-- | Atomically write a file, by first writing the contents into a temporary
-- file and then renaming it to the old position.
atomicWriteFile :: FilePath -> String -> IO ()
atomicWriteFile path contents = atomicUpdateFile path
(\_ fh -> hPutStr fh contents)
-- | Atomically update a file, by first creating a temporary file, running the
-- given action on it, and then renaming it to the old position.
-- Usually the action will write to the file and update its permissions.
-- The action is allowed to close the file descriptor, but isn't required to do
-- so.
atomicUpdateFile :: (MonadBaseControl IO m)
=> FilePath -> (FilePath -> Handle -> m a) -> m a
atomicUpdateFile path action = do
(tmppath, tmphandle) <- liftBase $ openTempFile (takeDirectory path)
(takeBaseName path)
r <- L.finally (action tmppath tmphandle) (liftBase $ hClose tmphandle)
-- if all went well, rename the file
liftBase $ renameFile tmppath path
return r
-- | Opens a file in a R/W mode, locks it (blocking if needed) and runs
-- a given action while the file is locked. Releases the lock and
-- closes the file afterwards.
withLockedFile :: (MonadError e m, Error e, MonadBaseControl IO m)
=> FilePath -> (Fd -> m a) -> m a
withLockedFile path =
L.bracket (openAndLock path) (liftBase . closeFd)
where
openAndLock :: (MonadError e m, Error e, MonadBaseControl IO m)
=> FilePath -> m Fd
openAndLock p = liftBase $ do
fd <- openFd p ReadWrite Nothing defaultFileFlags
waitToSetLock fd (WriteLock, AbsoluteSeek, 0, 0)
return fd
-- | Just as 'atomicUpdateFile', but in addition locks the file during the
-- operation using 'withLockedFile' and checks if the file has been modified.
-- The action is only run if it hasn't, otherwise an error is thrown.
-- The file must exist.
-- Returns the new file status after the operation is finished.
atomicUpdateLockedFile :: FilePath
-> FStat
-> (FilePath -> Handle -> IO a)
-> ResultT IOError IO (FStat, a)
atomicUpdateLockedFile path fstat action =
withLockedFile path checkStatAndRun
where
checkStatAndRun _ = do
newstat <- liftIO $ getFStat path
unless (fstat == newstat)
(failError $ "Cannot overwrite file " ++ path ++
": it has been modified since last written" ++
" (" ++ show fstat ++ " != " ++ show newstat ++ ")")
liftIO $ atomicUpdateFile path actionAndStat
actionAndStat tmppath tmphandle = do
r <- action tmppath tmphandle
hClose tmphandle -- close the handle so that we get meaningful stats
finalstat <- liftIO $ getFStat tmppath
return (finalstat, r)
-- | Just as 'atomicUpdateLockedFile', but discards the action result.
atomicUpdateLockedFile_ :: FilePath
-> FStat
-> (FilePath -> Handle -> IO a)
-> ResultT IOError IO FStat
atomicUpdateLockedFile_ path oldstat
= liftM fst . atomicUpdateLockedFile path oldstat
-- | Attempt, in a non-blocking way, to obtain a lock on a given file; report
-- back success.
lockFile :: FilePath -> IO (Result ())
......
{-# LANGUAGE FlexibleContexts #-}
{-| Utility functions for atomic file access. -}
{-
Copyright (C) 2009, 2010, 2011, 2012, 2013 Google Inc.
This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.
This program is distributed in the hope that it will be useful, but
WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
02110-1301, USA.
-}
module Ganeti.Utils.Atomic
( atomicWriteFile
, atomicUpdateFile
, withLockedFile
, atomicUpdateLockedFile
, atomicUpdateLockedFile_
) where
import qualified Control.Exception.Lifted as L
import Control.Monad
import Control.Monad.Base (MonadBase(..))
import Control.Monad.Error
import Control.Monad.Trans.Control
import System.FilePath.Posix (takeDirectory, takeBaseName)
import System.IO
import System.Directory (renameFile)
import System.Posix.IO
import System.Posix.Types
import Ganeti.BasicTypes
import Ganeti.Errors
import Ganeti.Utils
-- | Atomically write a file, by first writing the contents into a temporary
-- file and then renaming it to the old position.
atomicWriteFile :: FilePath -> String -> IO ()
atomicWriteFile path contents = atomicUpdateFile path
(\_ fh -> hPutStr fh contents)
-- | Atomically update a file, by first creating a temporary file, running the
-- given action on it, and then renaming it to the old position.
-- Usually the action will write to the file and update its permissions.
-- The action is allowed to close the file descriptor, but isn't required to do
-- so.
atomicUpdateFile :: (MonadBaseControl IO m)
=> FilePath -> (FilePath -> Handle -> m a) -> m a
atomicUpdateFile path action = do
(tmppath, tmphandle) <- liftBase $ openTempFile (takeDirectory path)
(takeBaseName path)
r <- L.finally (action tmppath tmphandle) (liftBase $ hClose tmphandle)
-- if all went well, rename the file
liftBase $ renameFile tmppath path
return r
-- | Opens a file in a R/W mode, locks it (blocking if needed) and runs
-- a given action while the file is locked. Releases the lock and
-- closes the file afterwards.
withLockedFile :: (MonadError e m, Error e, MonadBaseControl IO m)
=> FilePath -> (Fd -> m a) -> m a
withLockedFile path =
L.bracket (openAndLock path) (liftBase . closeFd)
where
openAndLock :: (MonadError e m, Error e, MonadBaseControl IO m)
=> FilePath -> m Fd
openAndLock p = liftBase $ do
fd <- openFd p ReadWrite Nothing defaultFileFlags
waitToSetLock fd (WriteLock, AbsoluteSeek, 0, 0)
return fd
-- | Just as 'atomicUpdateFile', but in addition locks the file during the
-- operation using 'withLockedFile' and checks if the file has been modified.
-- The action is only run if it hasn't, otherwise an error is thrown.
-- The file must exist.
-- Returns the new file status after the operation is finished.
atomicUpdateLockedFile :: FilePath
-> FStat
-> (FilePath -> Handle -> IO a)
-> ResultG (FStat, a)
atomicUpdateLockedFile path fstat action =
toErrorBase . withErrorT (LockError . (show :: IOError -> String))
$ withLockedFile path checkStatAndRun
where
checkStatAndRun _ = do
newstat <- liftIO $ getFStat path
unless (fstat == newstat)
(failError $ "Cannot overwrite file " ++ path ++
": it has been modified since last written" ++
" (" ++ show fstat ++ " != " ++ show newstat ++ ")")
liftIO $ atomicUpdateFile path actionAndStat
actionAndStat tmppath tmphandle = do
r <- action tmppath tmphandle
hClose tmphandle -- close the handle so that we get meaningful stats
finalstat <- liftIO $ getFStat tmppath
return (finalstat, r)
-- | Just as 'atomicUpdateLockedFile', but discards the action result.
atomicUpdateLockedFile_ :: FilePath
-> FStat
-> (FilePath -> Handle -> IO a)
-> ResultG FStat
atomicUpdateLockedFile_ path oldstat
= liftM fst . atomicUpdateLockedFile path oldstat
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment