Query.Exec: Describe error if talking to job process fails

When the forked (Python) job process dies for any reason, then the next `read`
from its pipe will fail, giving an unhelpful error like:

   GenericError "<file descriptor: 13>: hWaitForInput: end of file"

This message is also returned to whoever started the job, e.g. a CLI or RAPI
invocation. It does not say more than "in some server using some FD failed",
which doesn't help tracking down the issue.

This commit makes the error location more descriptive, turning it into
either of:

  "<file descriptor: 13>: ganeti job process input pipe: end of file
  "<file descriptor: 13>: ganeti job process output pipe: end of file

Signed-off-by: Niklas Hambuechen <niklash@google.com>
Signed-off-by: Klaus Aehlig <aehlig@google.com>
Reviewed-by: Klaus Aehlig <aehlig@google.com>

Conflicts:
	src/Ganeti/Query/Exec.hs - merge changes from both branches

Cherry-picked-from: 2823704fac79b11d1990fce9366375e145cb8f88
Signed-off-by: Petr Pudlak <pudlak@google.com>
Reviewed-by: Klaus Aehlig <aehlig@google.com>

diff --git a/src/Ganeti/Query/Exec.hs b/src/Ganeti/Query/Exec.hs
index 23830ca..75aa18d 100644 (file)
--- a/src/Ganeti/Query/Exec.hs
+++ b/src/Ganeti/Query/Exec.hs
@@ -62,6 +62,8 @@ module Ganeti.Query.Exec
 
 import Control.Concurrent (rtsSupportsBoundThreads)
 import Control.Concurrent.Lifted (threadDelay)
+import Control.Exception.Lifted (onException, throwIO)
+import qualified Control.Exception.Lifted as E
 import Control.Monad
 import Control.Monad.Error
 import Control.Monad.Trans.Maybe
@@ -70,7 +72,7 @@ import qualified Data.Map as M
 import Data.Maybe (listToMaybe, mapMaybe)
 import System.Directory (getDirectoryContents)
 import System.Environment
-import System.IO.Error (tryIOError)
+import System.IO.Error (tryIOError, annotateIOError)
 import System.Posix.Process
 import System.Posix.IO
 import System.Posix.Signals (sigABRT, sigKILL, sigTERM, signalProcess)
@@ -114,6 +116,14 @@ listOpenFds = liftM filterReadable
     filterReadable :: (Read a) => [String] -> [a]
     filterReadable = mapMaybe (fmap fst . listToMaybe . reads)
 
+
+-- | Catches a potential `IOError` and sets its description via
+-- `annotateIOError`. This makes exceptions more informative when they
+-- are thrown from an unnamed `Handle`.
+rethrowAnnotateIOError :: IO a -> String -> IO a
+rethrowAnnotateIOError f desc =
+  E.catch f (\e -> throwIO $ annotateIOError e desc Nothing Nothing)
+
 -- Code that is executed in a @fork@-ed process and that the replaces iteself
 -- with the actual job process
 runJobProcess :: JobId -> Client -> IO ()
@@ -249,10 +259,12 @@ forkJobProcess jid luxiLivelock update = do
       . (`mplus` (onError >> mzero))
       $ do
       let recv = liftIO $ recvMsg master
+                   `rethrowAnnotateIOError` "ganeti job process input pipe"
                    `onException`
                    logError "recv from ganeti job process pipe failed"
 
           send x = liftIO $ sendMsg master x
+                     `rethrowAnnotateIOError` "ganeti job process output pipe"
                      `onException`
                      logError "send to ganeti job process pipe failed"