Revision 5f6515b6 src/Ganeti/Utils.hs
b/src/Ganeti/Utils.hs | ||
---|---|---|
65 | 65 |
, setOwnerAndGroupFromNames |
66 | 66 |
, setOwnerWGroupR |
67 | 67 |
, formatOrdinal |
68 |
, atomicWriteFile |
|
69 |
, atomicUpdateFile |
|
70 |
, atomicUpdateLockedFile |
|
71 |
, atomicUpdateLockedFile_ |
|
72 | 68 |
, tryAndLogIOError |
73 | 69 |
, lockFile |
74 |
, withLockedFile |
|
75 | 70 |
, FStat |
76 | 71 |
, nullFStat |
77 | 72 |
, getFStat |
... | ... | |
85 | 80 |
|
86 | 81 |
import Control.Concurrent |
87 | 82 |
import Control.Exception (try) |
88 |
import qualified Control.Exception.Lifted as L |
|
89 | 83 |
import Control.Monad |
90 |
import Control.Monad.Base (MonadBase(..)) |
|
91 | 84 |
import Control.Monad.Error |
92 |
import Control.Monad.Trans.Control |
|
93 | 85 |
import Data.Char (toUpper, isAlphaNum, isDigit, isSpace) |
94 | 86 |
import qualified Data.Either as E |
95 | 87 |
import Data.Function (on) |
... | ... | |
98 | 90 |
import qualified Data.Map as M |
99 | 91 |
import Numeric (showOct) |
100 | 92 |
import System.Directory (renameFile, createDirectoryIfMissing) |
101 |
import System.FilePath.Posix (takeDirectory, takeBaseName)
|
|
93 |
import System.FilePath.Posix (takeDirectory) |
|
102 | 94 |
import System.INotify |
103 | 95 |
import System.Posix.Types |
104 | 96 |
|
... | ... | |
559 | 551 |
where tens = num `mod` 10 |
560 | 552 |
suffix s = show num ++ s |
561 | 553 |
|
562 |
-- | Atomically write a file, by first writing the contents into a temporary |
|
563 |
-- file and then renaming it to the old position. |
|
564 |
atomicWriteFile :: FilePath -> String -> IO () |
|
565 |
atomicWriteFile path contents = atomicUpdateFile path |
|
566 |
(\_ fh -> hPutStr fh contents) |
|
567 |
|
|
568 |
-- | Atomically update a file, by first creating a temporary file, running the |
|
569 |
-- given action on it, and then renaming it to the old position. |
|
570 |
-- Usually the action will write to the file and update its permissions. |
|
571 |
-- The action is allowed to close the file descriptor, but isn't required to do |
|
572 |
-- so. |
|
573 |
atomicUpdateFile :: (MonadBaseControl IO m) |
|
574 |
=> FilePath -> (FilePath -> Handle -> m a) -> m a |
|
575 |
atomicUpdateFile path action = do |
|
576 |
(tmppath, tmphandle) <- liftBase $ openTempFile (takeDirectory path) |
|
577 |
(takeBaseName path) |
|
578 |
r <- L.finally (action tmppath tmphandle) (liftBase $ hClose tmphandle) |
|
579 |
-- if all went well, rename the file |
|
580 |
liftBase $ renameFile tmppath path |
|
581 |
return r |
|
582 |
|
|
583 |
-- | Opens a file in a R/W mode, locks it (blocking if needed) and runs |
|
584 |
-- a given action while the file is locked. Releases the lock and |
|
585 |
-- closes the file afterwards. |
|
586 |
withLockedFile :: (MonadError e m, Error e, MonadBaseControl IO m) |
|
587 |
=> FilePath -> (Fd -> m a) -> m a |
|
588 |
withLockedFile path = |
|
589 |
L.bracket (openAndLock path) (liftBase . closeFd) |
|
590 |
where |
|
591 |
openAndLock :: (MonadError e m, Error e, MonadBaseControl IO m) |
|
592 |
=> FilePath -> m Fd |
|
593 |
openAndLock p = liftBase $ do |
|
594 |
fd <- openFd p ReadWrite Nothing defaultFileFlags |
|
595 |
waitToSetLock fd (WriteLock, AbsoluteSeek, 0, 0) |
|
596 |
return fd |
|
597 |
|
|
598 |
-- | Just as 'atomicUpdateFile', but in addition locks the file during the |
|
599 |
-- operation using 'withLockedFile' and checks if the file has been modified. |
|
600 |
-- The action is only run if it hasn't, otherwise an error is thrown. |
|
601 |
-- The file must exist. |
|
602 |
-- Returns the new file status after the operation is finished. |
|
603 |
atomicUpdateLockedFile :: FilePath |
|
604 |
-> FStat |
|
605 |
-> (FilePath -> Handle -> IO a) |
|
606 |
-> ResultT IOError IO (FStat, a) |
|
607 |
atomicUpdateLockedFile path fstat action = |
|
608 |
withLockedFile path checkStatAndRun |
|
609 |
where |
|
610 |
checkStatAndRun _ = do |
|
611 |
newstat <- liftIO $ getFStat path |
|
612 |
unless (fstat == newstat) |
|
613 |
(failError $ "Cannot overwrite file " ++ path ++ |
|
614 |
": it has been modified since last written" ++ |
|
615 |
" (" ++ show fstat ++ " != " ++ show newstat ++ ")") |
|
616 |
liftIO $ atomicUpdateFile path actionAndStat |
|
617 |
actionAndStat tmppath tmphandle = do |
|
618 |
r <- action tmppath tmphandle |
|
619 |
hClose tmphandle -- close the handle so that we get meaningful stats |
|
620 |
finalstat <- liftIO $ getFStat tmppath |
|
621 |
return (finalstat, r) |
|
622 |
|
|
623 |
-- | Just as 'atomicUpdateLockedFile', but discards the action result. |
|
624 |
atomicUpdateLockedFile_ :: FilePath |
|
625 |
-> FStat |
|
626 |
-> (FilePath -> Handle -> IO a) |
|
627 |
-> ResultT IOError IO FStat |
|
628 |
atomicUpdateLockedFile_ path oldstat |
|
629 |
= liftM fst . atomicUpdateLockedFile path oldstat |
|
630 |
|
|
631 | 554 |
-- | Attempt, in a non-blocking way, to obtain a lock on a given file; report |
632 | 555 |
-- back success. |
633 | 556 |
lockFile :: FilePath -> IO (Result ()) |
Also available in: Unified diff