Allow to re-use passphrases accross multiple runKeyring operations

2 files changed, 30 insertions, 18 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index ab7450b..14d4747 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -360,6 +360,7 @@ data KeyRingRuntime = KeyRingRuntime
                         -- 'KeyRingFile'.  If 'AutoAccess' was specified
                         -- for a file, this 'Map.Map' will indicate the
                         -- detected value that was used by the algorithm.
+                        , rtPassphrases :: MappedPacket -> IO (KikiCondition Packet)
                         }
 
 -- | TODO: Packet Update should have deletion action
@@ -378,6 +379,8 @@ data PassphraseSpec = PassphraseSpec
     , passSpecPassFile :: InputFile
     -- ^ The passphrase will be read from this file or file descriptor.
     }
+    -- | Use this to carry pasphrases from a previous run.
+    | PassphraseMemoizer (MappedPacket -> IO (KikiCondition Packet))
 
 data Transform =
         Autosign
@@ -1348,6 +1351,7 @@ buildKeyDB ctx grip0 keyring = do
                              , rtWorkingKey = wk
                              , rtRingAccess = accs
                              , rtKeyDB = Map.empty
+                             , rtPassphrases = doDecrypt
                              }
     transformed0 <-
         let trans f (info,ps) = do
@@ -1938,9 +1942,9 @@ rsaPrivateKeyFromPacket _ = Nothing
 
 writeKeyToFile ::
   Bool -> String -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)]
-writeKeyToFile False "PEM" fname packet =
+writeKeyToFile False "PEM" fname packet = do
     case key_algorithm packet of
-    RSA -> do
+     RSA -> do
         flip (maybe (return []))
              (rsaPrivateKeyFromPacket packet) -- RSAPrivateKey
             $ \rsa -> do
@@ -1956,7 +1960,7 @@ writeKeyToFile False "PEM" fname packet =
             writeStamped (InputFileContext "" "") fname stamp output
             setFileCreationMask saved_mask
             return [(fname, ExportedSubkey)]
-    algo -> return [(fname, UnableToExport algo $ fingerprint packet)]
+     algo -> return [(fname, UnableToExport algo $ fingerprint packet)]
 
 writePEMKeys :: (MappedPacket -> IO (KikiCondition Packet))
                 -> KeyDB
@@ -1981,7 +1985,8 @@ writePEMKeys doDecrypt db exports = do
 makeMemoizingDecrypter :: KeyRingOperation -> InputFileContext
                         -> Map.Map KeyKey MappedPacket
                         -> IO (MappedPacket -> IO (KikiCondition Packet))
-makeMemoizingDecrypter operation ctx keys = do
+makeMemoizingDecrypter operation ctx keys =
+   if null chains then  do
     -- (*) Notice we do not pass ctx to resolveForReport.
     -- This is because the merge function does not currently use a context
     -- and the pws map keys must match the MappedPacket locations.
@@ -1994,21 +1999,26 @@ makeMemoizingDecrypter operation ctx keys = do
                          (Map.mapKeys (resolveForReport Nothing) -- see note (*) note above
                             $ Map.filter (isJust . pwfile . typ) $ opFiles operation)
     -}
-    pws2 <- 
-        Traversable.mapM (cachedContents ctx)
-         $ Map.fromList $ mapMaybe
-                (\spec -> (,passSpecPassFile spec) `fmap` do
-                    guard $ isNothing $ passSpecKeySpec spec
-                    passSpecRingFile spec)
-                (opPassphrases operation)
-    defpw <- do
-        Traversable.mapM (cachedContents ctx . passSpecPassFile)
-         $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp)
-                                        && isNothing (passSpecKeySpec sp))
-                                    $ opPassphrases operation
-    unkeysRef <- newIORef (Map.empty :: Map.Map KeyKey Packet)
-    return $ doDecrypt unkeysRef ({- pws `Map.union` -} pws2) defpw
+        pws2 <- 
+            Traversable.mapM (cachedContents ctx)
+             $ Map.fromList $ mapMaybe
+                    (\spec -> (,passSpecPassFile spec) `fmap` do
+                        guard $ isNothing $ passSpecKeySpec spec
+                        passSpecRingFile spec)
+                    passspecs
+        defpw <- do
+            Traversable.mapM (cachedContents ctx . passSpecPassFile)
+             $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp)
+                                            && isNothing (passSpecKeySpec sp))
+                                        $ opPassphrases operation
+        unkeysRef <- newIORef (Map.empty :: Map.Map KeyKey Packet)
+        return $ doDecrypt unkeysRef ({- pws `Map.union` -} pws2) defpw
+    else let PassphraseMemoizer f = head chains
+         in return f
  where
+    (chains,passspecs) = partition isChain $ opPassphrases operation
+                            where isChain (PassphraseMemoizer {}) = True
+                                  isChain _ = False
     doDecrypt :: IORef (Map.Map KeyKey Packet)
                 -> Map.Map FilePath (IO S.ByteString)
                 -> Maybe (IO S.ByteString)
@@ -2353,6 +2363,7 @@ runKeyRing operation = do
                        , rtWorkingKey = fmap packet wk
                        , rtKeyDB = db
                        , rtRingAccess = accs
+                       , rtPassphrases = decrypt
                        }
 
         r <- performManipulations decrypt
diff --git a/kiki.hs b/kiki.hs
index 607a935..b39338d 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1216,6 +1216,7 @@ kiki "init-key" args = do
                 , ( ArgFile ipsecpath, peminfo 1024 "strongswan" )
                 , ( ArgFile sshcpath, peminfo 2048 "ssh-client" )
                 , ( ArgFile sshspath, peminfo 2048 "ssh-server" ) ]
+             , opPassphrases = [ PassphraseMemoizer (rtPassphrases rt) ]
              }
     forM_ [sshcpath,sshspath,ipsecpath] mkdirFor
     KikiResult rt report <- runKeyRing op2