summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--KeyRing.hs47
-rw-r--r--kiki.hs1
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
360 -- 'KeyRingFile'. If 'AutoAccess' was specified 360 -- 'KeyRingFile'. If 'AutoAccess' was specified
361 -- for a file, this 'Map.Map' will indicate the 361 -- for a file, this 'Map.Map' will indicate the
362 -- detected value that was used by the algorithm. 362 -- detected value that was used by the algorithm.
363 , rtPassphrases :: MappedPacket -> IO (KikiCondition Packet)
363 } 364 }
364 365
365-- | TODO: Packet Update should have deletion action 366-- | TODO: Packet Update should have deletion action
@@ -378,6 +379,8 @@ data PassphraseSpec = PassphraseSpec
378 , passSpecPassFile :: InputFile 379 , passSpecPassFile :: InputFile
379 -- ^ The passphrase will be read from this file or file descriptor. 380 -- ^ The passphrase will be read from this file or file descriptor.
380 } 381 }
382 -- | Use this to carry pasphrases from a previous run.
383 | PassphraseMemoizer (MappedPacket -> IO (KikiCondition Packet))
381 384
382data Transform = 385data Transform =
383 Autosign 386 Autosign
@@ -1348,6 +1351,7 @@ buildKeyDB ctx grip0 keyring = do
1348 , rtWorkingKey = wk 1351 , rtWorkingKey = wk
1349 , rtRingAccess = accs 1352 , rtRingAccess = accs
1350 , rtKeyDB = Map.empty 1353 , rtKeyDB = Map.empty
1354 , rtPassphrases = doDecrypt
1351 } 1355 }
1352 transformed0 <- 1356 transformed0 <-
1353 let trans f (info,ps) = do 1357 let trans f (info,ps) = do
@@ -1938,9 +1942,9 @@ rsaPrivateKeyFromPacket _ = Nothing
1938 1942
1939writeKeyToFile :: 1943writeKeyToFile ::
1940 Bool -> String -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)] 1944 Bool -> String -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)]
1941writeKeyToFile False "PEM" fname packet = 1945writeKeyToFile False "PEM" fname packet = do
1942 case key_algorithm packet of 1946 case key_algorithm packet of
1943 RSA -> do 1947 RSA -> do
1944 flip (maybe (return [])) 1948 flip (maybe (return []))
1945 (rsaPrivateKeyFromPacket packet) -- RSAPrivateKey 1949 (rsaPrivateKeyFromPacket packet) -- RSAPrivateKey
1946 $ \rsa -> do 1950 $ \rsa -> do
@@ -1956,7 +1960,7 @@ writeKeyToFile False "PEM" fname packet =
1956 writeStamped (InputFileContext "" "") fname stamp output 1960 writeStamped (InputFileContext "" "") fname stamp output
1957 setFileCreationMask saved_mask 1961 setFileCreationMask saved_mask
1958 return [(fname, ExportedSubkey)] 1962 return [(fname, ExportedSubkey)]
1959 algo -> return [(fname, UnableToExport algo $ fingerprint packet)] 1963 algo -> return [(fname, UnableToExport algo $ fingerprint packet)]
1960 1964
1961writePEMKeys :: (MappedPacket -> IO (KikiCondition Packet)) 1965writePEMKeys :: (MappedPacket -> IO (KikiCondition Packet))
1962 -> KeyDB 1966 -> KeyDB
@@ -1981,7 +1985,8 @@ writePEMKeys doDecrypt db exports = do
1981makeMemoizingDecrypter :: KeyRingOperation -> InputFileContext 1985makeMemoizingDecrypter :: KeyRingOperation -> InputFileContext
1982 -> Map.Map KeyKey MappedPacket 1986 -> Map.Map KeyKey MappedPacket
1983 -> IO (MappedPacket -> IO (KikiCondition Packet)) 1987 -> IO (MappedPacket -> IO (KikiCondition Packet))
1984makeMemoizingDecrypter operation ctx keys = do 1988makeMemoizingDecrypter operation ctx keys =
1989 if null chains then do
1985 -- (*) Notice we do not pass ctx to resolveForReport. 1990 -- (*) Notice we do not pass ctx to resolveForReport.
1986 -- This is because the merge function does not currently use a context 1991 -- This is because the merge function does not currently use a context
1987 -- and the pws map keys must match the MappedPacket locations. 1992 -- and the pws map keys must match the MappedPacket locations.
@@ -1994,21 +1999,26 @@ makeMemoizingDecrypter operation ctx keys = do
1994 (Map.mapKeys (resolveForReport Nothing) -- see note (*) note above 1999 (Map.mapKeys (resolveForReport Nothing) -- see note (*) note above
1995 $ Map.filter (isJust . pwfile . typ) $ opFiles operation) 2000 $ Map.filter (isJust . pwfile . typ) $ opFiles operation)
1996 -} 2001 -}
1997 pws2 <- 2002 pws2 <-
1998 Traversable.mapM (cachedContents ctx) 2003 Traversable.mapM (cachedContents ctx)
1999 $ Map.fromList $ mapMaybe 2004 $ Map.fromList $ mapMaybe
2000 (\spec -> (,passSpecPassFile spec) `fmap` do 2005 (\spec -> (,passSpecPassFile spec) `fmap` do
2001 guard $ isNothing $ passSpecKeySpec spec 2006 guard $ isNothing $ passSpecKeySpec spec
2002 passSpecRingFile spec) 2007 passSpecRingFile spec)
2003 (opPassphrases operation) 2008 passspecs
2004 defpw <- do 2009 defpw <- do
2005 Traversable.mapM (cachedContents ctx . passSpecPassFile) 2010 Traversable.mapM (cachedContents ctx . passSpecPassFile)
2006 $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp) 2011 $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp)
2007 && isNothing (passSpecKeySpec sp)) 2012 && isNothing (passSpecKeySpec sp))
2008 $ opPassphrases operation 2013 $ opPassphrases operation
2009 unkeysRef <- newIORef (Map.empty :: Map.Map KeyKey Packet) 2014 unkeysRef <- newIORef (Map.empty :: Map.Map KeyKey Packet)
2010 return $ doDecrypt unkeysRef ({- pws `Map.union` -} pws2) defpw 2015 return $ doDecrypt unkeysRef ({- pws `Map.union` -} pws2) defpw
2016 else let PassphraseMemoizer f = head chains
2017 in return f
2011 where 2018 where
2019 (chains,passspecs) = partition isChain $ opPassphrases operation
2020 where isChain (PassphraseMemoizer {}) = True
2021 isChain _ = False
2012 doDecrypt :: IORef (Map.Map KeyKey Packet) 2022 doDecrypt :: IORef (Map.Map KeyKey Packet)
2013 -> Map.Map FilePath (IO S.ByteString) 2023 -> Map.Map FilePath (IO S.ByteString)
2014 -> Maybe (IO S.ByteString) 2024 -> Maybe (IO S.ByteString)
@@ -2353,6 +2363,7 @@ runKeyRing operation = do
2353 , rtWorkingKey = fmap packet wk 2363 , rtWorkingKey = fmap packet wk
2354 , rtKeyDB = db 2364 , rtKeyDB = db
2355 , rtRingAccess = accs 2365 , rtRingAccess = accs
2366 , rtPassphrases = decrypt
2356 } 2367 }
2357 2368
2358 r <- performManipulations decrypt 2369 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
1216 , ( ArgFile ipsecpath, peminfo 1024 "strongswan" ) 1216 , ( ArgFile ipsecpath, peminfo 1024 "strongswan" )
1217 , ( ArgFile sshcpath, peminfo 2048 "ssh-client" ) 1217 , ( ArgFile sshcpath, peminfo 2048 "ssh-client" )
1218 , ( ArgFile sshspath, peminfo 2048 "ssh-server" ) ] 1218 , ( ArgFile sshspath, peminfo 2048 "ssh-server" ) ]
1219 , opPassphrases = [ PassphraseMemoizer (rtPassphrases rt) ]
1219 } 1220 }
1220 forM_ [sshcpath,sshspath,ipsecpath] mkdirFor 1221 forM_ [sshcpath,sshspath,ipsecpath] mkdirFor
1221 KikiResult rt report <- runKeyRing op2 1222 KikiResult rt report <- runKeyRing op2