From be0cb2d73124f93be0a7de7ac9079430696252a9 Mon Sep 17 00:00:00 2001
From: Michele Tartara <mtartara@google.com>
Date: Thu, 4 Apr 2013 18:49:49 +0200
Subject: [PATCH] Properly export errors while reading job list
In case of problems while reading the job list from disk (such as permission
errors) confd would silently fail, writing a warning on the log file but
sending an empty list and no error message to the client.
Also, tests have been updated in accordance to the new interface of the modified
functions.
This commit fixes this problem [Issue 405].
Signed-off-by: Michele Tartara <mtartara@google.com>
Reviewed-by: Guido Trotter <ultrotter@google.com>
---
src/Ganeti/JQueue.hs | 26 +++++++++++++++-----------
src/Ganeti/Query/Query.hs | 13 +++++++++----
test/hs/Test/Ganeti/JQueue.hs | 15 ++++++++++++---
3 files changed, 36 insertions(+), 18 deletions(-)
diff --git a/src/Ganeti/JQueue.hs b/src/Ganeti/JQueue.hs
index 39aa3fc60..e439aa2fd 100644
--- a/src/Ganeti/JQueue.hs
+++ b/src/Ganeti/JQueue.hs
@@ -231,24 +231,28 @@ determineJobDirectories rootdir archived = do
return $ rootdir:other
-- | Computes the list of all jobs in the given directories.
-getJobIDs :: [FilePath] -> IO [JobId]
-getJobIDs = liftM concat . mapM getDirJobIDs
+getJobIDs :: [FilePath] -> IO (Either IOError [JobId])
+getJobIDs paths = liftM (fmap concat . sequence) (mapM getDirJobIDs paths)
-- | Sorts the a list of job IDs.
sortJobIDs :: [JobId] -> [JobId]
sortJobIDs = sortBy (comparing fromJobId)
-- | Computes the list of jobs in a given directory.
-getDirJobIDs :: FilePath -> IO [JobId]
+getDirJobIDs :: FilePath -> IO (Either IOError [JobId])
getDirJobIDs path = do
- contents <- getDirectoryContents path `Control.Exception.catch`
- ignoreIOError [] False
- ("Failed to list job directory " ++ path)
- let jids = foldl (\ids file ->
- case parseJobFileId file of
- Nothing -> ids
- Just new_id -> new_id:ids) [] contents
- return $ reverse jids
+ either_contents <-
+ try (getDirectoryContents path) :: IO (Either IOError [FilePath])
+ case either_contents of
+ Left e -> do
+ logWarning $ "Failed to list job directory " ++ path ++ ": " ++ show e
+ return $ Left e
+ Right contents -> do
+ let jids = foldl (\ids file ->
+ case parseJobFileId file of
+ Nothing -> ids
+ Just new_id -> new_id:ids) [] contents
+ return . Right $ reverse jids
-- | Reads the job data from disk.
readJobDataFromDisk :: FilePath -> Bool -> JobId -> IO (Maybe (String, Bool))
diff --git a/src/Ganeti/Query/Query.hs b/src/Ganeti/Query/Query.hs
index ffdebf873..e6a00346a 100644
--- a/src/Ganeti/Query/Query.hs
+++ b/src/Ganeti/Query/Query.hs
@@ -53,7 +53,7 @@ module Ganeti.Query.Query
) where
import Control.DeepSeq
-import Control.Monad (filterM, liftM, foldM)
+import Control.Monad (filterM, foldM)
import Control.Monad.Trans (lift)
import Data.List (intercalate)
import Data.Maybe (fromMaybe)
@@ -218,9 +218,14 @@ queryJobs cfg live fields qfilter =
Bad msg -> resultT . Bad $ GenericError msg
Ok [] -> if live
-- we can check the filesystem for actual jobs
- then lift $ liftM sortJobIDs
- (determineJobDirectories rootdir want_arch >>=
- getJobIDs)
+ then do
+ maybeJobIDs <-
+ lift (determineJobDirectories rootdir want_arch
+ >>= getJobIDs)
+ case maybeJobIDs of
+ Left e -> (resultT . Bad) . BlockDeviceError $
+ "Unable to fetch the job list: " ++ show e
+ Right jobIDs -> resultT . Ok $ sortJobIDs jobIDs
-- else we shouldn't look at the filesystem...
else return []
Ok v -> resultT $ Ok v
diff --git a/test/hs/Test/Ganeti/JQueue.hs b/test/hs/Test/Ganeti/JQueue.hs
index d2d946fec..e23733644 100644
--- a/test/hs/Test/Ganeti/JQueue.hs
+++ b/test/hs/Test/Ganeti/JQueue.hs
@@ -176,18 +176,27 @@ case_JobStatusPri_py_equiv = do
-- | Tests listing of Job ids.
prop_ListJobIDs :: Property
prop_ListJobIDs = monadicIO $ do
+ let extractJobIDs jIDs = do
+ either_jobs <- jIDs
+ case either_jobs of
+ Right j -> return j
+ Left e -> fail $ show e
+ isLeft e =
+ case e of
+ Left _ -> True
+ _ -> False
jobs <- pick $ resize 10 (listOf1 genJobId `suchThat` (\l -> l == nub l))
(e, f, g) <-
run . withSystemTempDirectory "jqueue-test." $ \tempdir -> do
- empty_dir <- getJobIDs [tempdir]
+ empty_dir <- extractJobIDs $ getJobIDs [tempdir]
mapM_ (\jid -> writeFile (tempdir </> jobFileName jid) "") jobs
- full_dir <- getJobIDs [tempdir]
+ full_dir <- extractJobIDs $ getJobIDs [tempdir]
invalid_dir <- getJobIDs [tempdir </> "no-such-dir"]
return (empty_dir, sortJobIDs full_dir, invalid_dir)
stop $ conjoin [ printTestCase "empty directory" $ e ==? []
, printTestCase "directory with valid names" $
f ==? sortJobIDs jobs
- , printTestCase "invalid directory" $ g ==? []
+ , printTestCase "invalid directory" $ isLeft g
]
-- | Tests loading jobs from disk.
--
GitLab