On Thu, Nov 7, 2013 at 1:20 PM, Klaus Aehlig <[email protected]> wrote:
> Two avoid two processes simultaneously accessing the same
> on-file structure, like the job queue, file locks are used.
> Therefore, provide this functionality in Haskell as well.
>
> Signed-off-by: Klaus Aehlig <[email protected]>
> ---
>  src/Ganeti/Utils.hs | 13 ++++++++++++-
>  1 file changed, 12 insertions(+), 1 deletion(-)
>
> diff --git a/src/Ganeti/Utils.hs b/src/Ganeti/Utils.hs
> index 8658889..07fac49 100644
> --- a/src/Ganeti/Utils.hs
> +++ b/src/Ganeti/Utils.hs
> @@ -63,6 +63,7 @@ module Ganeti.Utils
>    , formatOrdinal
>    , atomicWriteFile
>    , tryAndLogIOError
> +  , lockFile
>    ) where
>
>  import Control.Exception (try)
> @@ -70,7 +71,7 @@ import Data.Char (toUpper, isAlphaNum, isDigit, isSpace)
>  import Data.Function (on)
>  import Data.List
>  import qualified Data.Map as M
> -import Control.Monad (foldM)
> +import Control.Monad (foldM, liftM)
>  import System.Directory (renameFile)
>  import System.FilePath.Posix (takeDirectory, takeBaseName)
>
> @@ -84,6 +85,7 @@ import Ganeti.Runtime
>  import System.IO
>  import System.Exit
>  import System.Posix.Files
> +import System.Posix.IO
>  import System.Time
>
>  -- * Debug functions
> @@ -515,3 +517,12 @@ atomicWriteFile path contents = do
>    hPutStr tmphandle contents
>    hClose tmphandle
>    renameFile tmppath path
> +
> +-- | Attempt, in a non-blocking way, to obtain a lock on a given file; report
> +-- back success.
> +lockFile :: FilePath -> IO (Result ())
> +lockFile path = do
> +  handle <- openFile path WriteMode
> +  fd <- handleToFd handle
> +  Control.Monad.liftM (either (Bad . show) Ok)
> +    (try (setLock fd (WriteLock, AbsoluteSeek, 0, 0)) :: IO (Either IOError 
> ()))
> --
> 1.8.4.1
>

LGTM, thanks.
Michele

-- 
Google Germany GmbH
Dienerstr. 12
80331 München

Registergericht und -nummer: Hamburg, HRB 86891
Sitz der Gesellschaft: Hamburg
Geschäftsführer: Graham Law, Christine Elizabeth Flores

Reply via email to