Just style nitpicking: s/Bad s->/Bad s ->/ LGTM, thanks (no need to resend).
On Thu, Jan 23, 2014 at 11:01 PM, Klaus Aehlig <[email protected]> wrote: > As jobs are archived in groups of 10000, creating new subdirectories > of the archive might be necessary when archiving a job. Use a > function that takes care of this. > > Signed-off-by: Klaus Aehlig <[email protected]> > --- > src/Ganeti/Query/Server.hs | 13 ++++++------- > 1 file changed, 6 insertions(+), 7 deletions(-) > > diff --git a/src/Ganeti/Query/Server.hs b/src/Ganeti/Query/Server.hs > index 64d75f8..d3cea12 100644 > --- a/src/Ganeti/Query/Server.hs > +++ b/src/Ganeti/Query/Server.hs > @@ -63,7 +63,7 @@ import Ganeti.Query.Query > import Ganeti.Query.Filter (makeSimpleFilter) > import Ganeti.Types > import qualified Ganeti.UDSServer as U (Handler(..), listener) > -import Ganeti.Utils (lockFile, exitIfBad, watchFile) > +import Ganeti.Utils (lockFile, exitIfBad, watchFile, safeRenameFile) > import qualified Ganeti.Version as Version > > -- | Helper for classic queries. > @@ -347,14 +347,13 @@ handleCall qlock _ cfg (ArchiveJob jid) = do > let mcs = Config.getMasterCandidates cfg > live = liveJobFile qDir jid > archive = archivedJobFile qDir jid > - renameResult <- try $ renameFile live archive > - :: IO (Either IOError ()) > + renameResult <- safeRenameFile live archive > putMVar qlock () > case renameResult of > - Left e -> return . Bad . JobQueueError > - $ "Archiving failed in an unexpected > way: " > - ++ show e > - Right () -> do > + Bad s-> return . Bad . JobQueueError > + $ "Archiving failed in an unexpected > way: " > + ++ s > + Ok () -> do > _ <- executeRpcCall mcs > $ RpcCallJobqueueRename [(live, > archive)] > return . Ok $ showJSON True > -- > 1.8.5.3 > >
