3 files changed, 44 insertions, 30 deletions

diff --git a/lib/GnuPGAgent.hs b/lib/GnuPGAgent.hs
index 7161b92..067e3bc 100644
--- a/lib/GnuPGAgent.hs
+++ b/lib/GnuPGAgent.hs
@@ -12,6 +12,7 @@ module GnuPGAgent
 
 import Debug.Trace
 import Control.Monad
+import ControlMaybe
 import Data.Char
 import Data.OpenPGP
 import Data.OpenPGP.Util
@@ -39,9 +40,11 @@ import Data.Word
 
 data GnuPGAgent = GnuPGAgent { agentHandle :: Handle }
 
+session :: IO (Maybe GnuPGAgent)
 session = do
     envhomedir Nothing gpgHomeSpec >>= \case
         Just gpghome -> do
+            handleIO_ (hPutStrLn stderr "Failed to connect to gpg-agent." >> return Nothing) $ do
             sock <- socket AF_UNIX Stream defaultProtocol
             connect sock (SockAddrUnix (gpghome ++ "/S.gpg-agent"))
             agent <- socketToHandle sock ReadWriteMode
diff --git a/lib/PacketTranscoder.hs b/lib/PacketTranscoder.hs
index f4b4cce..afbf55b 100644
--- a/lib/PacketTranscoder.hs
+++ b/lib/PacketTranscoder.hs
@@ -174,38 +174,42 @@ makeMemoizingDecrypter operation ctx (workingkey,keys) = do
                 --  allow you to run 'decryptIt' on an unencrypted public key
                 --  to obtain it's secret key.
                 handleIO_ (decryptIt []) $ do
-                (pw,wants_retry) <- getpw (count,qry)
-                let wkun = fromMaybe wk $ do
-                                guard $ symmetric_algorithm (packet mp) /= Unencrypted
-                                decryptSecretKey pw (packet mp)
-
-                    retryOrFail
-                        | Just clear <- wants_retry = if count < 4
-                                                        then tries (count+1) getpw recurse
-                                                        else clear >> recurse
-                        | otherwise                 = recurse
-
-                case symmetric_algorithm wkun of
-
-                    Unencrypted -> do
-                        writeIORef unkeysRef (Map.insert (kk,Unencrypted,S2K 100 "") wkun unkeys)
-                        ek <- case dest_alg of
-                                Unencrypted -> return $ Just wkun
-                                _           -> encryptSecretKey pw dest_s2k' dest_alg wkun
-
-                        case ek of
-                            Nothing   -> retryOrFail
-                            Just wken -> do
-                                modifyIORef unkeysRef (Map.insert (kk,dest_alg,dest_s2k') wken)
-                                return $ KikiSuccess wken
-
-                    _ -> retryOrFail
-
-            getpws = (map (const . fmap (,Nothing)) $ mapMaybe (`Map.lookup` pws) fs ++ maybeToList defpw) ++ [ agentpw | agent_requested ]
+                (pw0,wants_retry) <- getpw (count,qry)
+                case pw0 of
+                  KikiSuccess pw -> do
+                    let wkun = fromMaybe wk $ do
+                                    guard $ symmetric_algorithm (packet mp) /= Unencrypted
+                                    decryptSecretKey pw (packet mp)
+
+                        retryOrFail
+                            | Just clear <- wants_retry = if count < 4
+                                                            then tries (count+1) getpw recurse
+                                                            else clear >> recurse
+                            | otherwise                 = recurse
+
+                    case symmetric_algorithm wkun of
+
+                        Unencrypted -> do
+                            writeIORef unkeysRef (Map.insert (kk,Unencrypted,S2K 100 "") wkun unkeys)
+                            ek <- case dest_alg of
+                                    Unencrypted -> return $ Just wkun
+                                    _           -> encryptSecretKey pw dest_s2k' dest_alg wkun
+
+                            case ek of
+                                Nothing   -> retryOrFail
+                                Just wken -> do
+                                    modifyIORef unkeysRef (Map.insert (kk,dest_alg,dest_s2k') wken)
+                                    return $ KikiSuccess wken
+
+                        _ -> retryOrFail
+                  err -> return $ fmap (error "pasphrase error") err
+
+            getpws = (map (const . fmap (\pw -> (KikiSuccess pw,Nothing)))
+                        $ mapMaybe (`Map.lookup` pws) fs ++ maybeToList defpw) ++ [ agentpw | agent_requested ]
 
             agentpw (count,qry) = do
                     s <- session
-                    fromMaybe (return ("",Nothing)) $ do
+                    fromMaybe (return (AgentConnectionFailure,Nothing)) $ do
                     s <- s
                     Just $ do
                     let (firsttime,maink) | Just k <- (queryMainKey qry) = (2,k)
@@ -230,7 +234,12 @@ makeMemoizingDecrypter operation ctx (workingkey,keys) = do
                     -- putStrLn $ "(count,firsttime,ask,qry,actual_qry)="++show (count,firsttime,ask,sanitizeQry qry, sanitizeQry actual_qry)
                     mbpw <- getPassphrase s ask actual_qry
                     quit s
-                    return ( maybe "" S8.pack mbpw, guard (ask /= AskNew) >> Just clear )
+                    -- putStrLn $ "mbpw = " ++show mbpw
+                    return ( maybe (if count >=firsttime then OperationCanceled
+                                                         else KikiSuccess "") -- No cached data.
+                                   (KikiSuccess . S8.pack)
+                                   mbpw
+                           , guard (ask /= AskNew) >> Just clear )
 
         calls <- currentCallStack
         putStrLn $ concat [fingerprint wk," ", show (symmetric_algorithm wk,s2k wk)," --> ",show (dest_alg,dest_s2k)]
diff --git a/lib/Types.hs b/lib/Types.hs
index df2dfbe..686614e 100644
--- a/lib/Types.hs
+++ b/lib/Types.hs
@@ -236,6 +236,8 @@ data KikiCondition a = KikiSuccess a
     | AmbiguousKeySpec FilePath
     | CannotImportMasterKey
     | NoWorkingKey
+    | AgentConnectionFailure
+    | OperationCanceled
  deriving ( Functor, Show )
 
 instance FunctorToMaybe KikiCondition where