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

@@ -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))

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

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.