diff options
-rw-r--r-- | KeyRing.hs | 47 | ||||
-rw-r--r-- | kiki.hs | 1 |
2 files changed, 30 insertions, 18 deletions
@@ -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 | ||
382 | data Transform = | 385 | data 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 | ||
1939 | writeKeyToFile :: | 1943 | writeKeyToFile :: |
1940 | Bool -> String -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)] | 1944 | Bool -> String -> InputFile -> Packet -> IO [(InputFile, KikiReportAction)] |
1941 | writeKeyToFile False "PEM" fname packet = | 1945 | writeKeyToFile 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 | ||
1961 | writePEMKeys :: (MappedPacket -> IO (KikiCondition Packet)) | 1965 | writePEMKeys :: (MappedPacket -> IO (KikiCondition Packet)) |
1962 | -> KeyDB | 1966 | -> KeyDB |
@@ -1981,7 +1985,8 @@ writePEMKeys doDecrypt db exports = do | |||
1981 | makeMemoizingDecrypter :: KeyRingOperation -> InputFileContext | 1985 | makeMemoizingDecrypter :: KeyRingOperation -> InputFileContext |
1982 | -> Map.Map KeyKey MappedPacket | 1986 | -> Map.Map KeyKey MappedPacket |
1983 | -> IO (MappedPacket -> IO (KikiCondition Packet)) | 1987 | -> IO (MappedPacket -> IO (KikiCondition Packet)) |
1984 | makeMemoizingDecrypter operation ctx keys = do | 1988 | makeMemoizingDecrypter 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 |
@@ -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 |