summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/PacketTranscoder.hs26
1 files changed, 17 insertions, 9 deletions
diff --git a/lib/PacketTranscoder.hs b/lib/PacketTranscoder.hs
index 6d1d9b8..f4b4cce 100644
--- a/lib/PacketTranscoder.hs
+++ b/lib/PacketTranscoder.hs
@@ -3,6 +3,7 @@
3{-# LANGUAGE PatternGuards #-} 3{-# LANGUAGE PatternGuards #-}
4module PacketTranscoder where 4module PacketTranscoder where
5 5
6import GHC.Stack
6import Control.Monad 7import Control.Monad
7import Data.IORef 8import Data.IORef
8import Data.List 9import Data.List
@@ -127,7 +128,7 @@ makeMemoizingDecrypter operation ctx (workingkey,keys) = do
127 $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp) 128 $ listToMaybe $ filter (\sp -> isNothing (passSpecRingFile sp)
128 && isNothing (passSpecKeySpec sp)) 129 && isNothing (passSpecKeySpec sp))
129 $ passspecs 130 $ passspecs
130 unkeysRef <- newIORef (Map.empty :: Map.Map KeyKey Packet) 131 unkeysRef <- newIORef (Map.empty :: Map.Map (KeyKey,SymmetricAlgorithm,S2K) Packet)
131 return $ doDecrypt unkeysRef ({- pws `Map.union` -} pws2) defpw (not $ null agentspec) 132 return $ doDecrypt unkeysRef ({- pws `Map.union` -} pws2) defpw (not $ null agentspec)
132 else let PassphraseMemoizer f = head chains 133 else let PassphraseMemoizer f = head chains
133 in return f 134 in return f
@@ -138,7 +139,7 @@ makeMemoizingDecrypter operation ctx (workingkey,keys) = do
138 (agentspec,passspecs) = partition isAgent passspecs0 139 (agentspec,passspecs) = partition isAgent passspecs0
139 where isAgent PassphraseAgent = True 140 where isAgent PassphraseAgent = True
140 isAgent _ = False 141 isAgent _ = False
141 doDecrypt :: IORef (Map.Map KeyKey Packet) 142 doDecrypt :: IORef (Map.Map (KeyKey,SymmetricAlgorithm,S2K) Packet)
142 -> Map.Map FilePath (IO S.ByteString) 143 -> Map.Map FilePath (IO S.ByteString)
143 -> Maybe (IO S.ByteString) 144 -> Maybe (IO S.ByteString)
144 -> Bool 145 -> Bool
@@ -155,6 +156,9 @@ makeMemoizingDecrypter operation ctx (workingkey,keys) = do
155 q <- fmap packet $ Map.lookup (keykey working) keys 156 q <- fmap packet $ Map.lookup (keykey working) keys
156 return (mp0, Query (packet mp0) (queryUID q) (Just working))) 157 return (mp0, Query (packet mp0) (queryUID q) (Just working)))
157 158
159 dest_s2k' | dest_alg==Unencrypted = S2K 100 ""
160 | otherwise = dest_s2k
161
158 wk = packet mp0 162 wk = packet mp0
159 kk = keykey wk 163 kk = keykey wk
160 fs = Map.keys $ locations mp 164 fs = Map.keys $ locations mp
@@ -184,13 +188,16 @@ makeMemoizingDecrypter operation ctx (workingkey,keys) = do
184 case symmetric_algorithm wkun of 188 case symmetric_algorithm wkun of
185 189
186 Unencrypted -> do 190 Unencrypted -> do
187 writeIORef unkeysRef (Map.insert kk wkun unkeys) 191 writeIORef unkeysRef (Map.insert (kk,Unencrypted,S2K 100 "") wkun unkeys)
188 ek <- case dest_alg of 192 ek <- case dest_alg of
189 Unencrypted -> return $ Just wkun 193 Unencrypted -> return $ Just wkun
190 _ -> encryptSecretKey pw dest_s2k dest_alg wkun 194 _ -> encryptSecretKey pw dest_s2k' dest_alg wkun
195
191 case ek of 196 case ek of
192 Nothing -> retryOrFail 197 Nothing -> retryOrFail
193 Just wken -> return $ KikiSuccess wken 198 Just wken -> do
199 modifyIORef unkeysRef (Map.insert (kk,dest_alg,dest_s2k') wken)
200 return $ KikiSuccess wken
194 201
195 _ -> retryOrFail 202 _ -> retryOrFail
196 203
@@ -225,13 +232,14 @@ makeMemoizingDecrypter operation ctx (workingkey,keys) = do
225 quit s 232 quit s
226 return ( maybe "" S8.pack mbpw, guard (ask /= AskNew) >> Just clear ) 233 return ( maybe "" S8.pack mbpw, guard (ask /= AskNew) >> Just clear )
227 234
228 -- putStrLn $ concat [show (symmetric_algorithm wk,s2k wk)," --> ",show (dest_alg,dest_s2k)] 235 calls <- currentCallStack
229 if symmetric_algorithm wk == dest_alg 236 putStrLn $ concat [fingerprint wk," ", show (symmetric_algorithm wk,s2k wk)," --> ",show (dest_alg,dest_s2k)]
230 && ( symmetric_algorithm wk == Unencrypted || s2k wk == dest_s2k ) 237 mapM_ putStrLn calls
238 if symmetric_algorithm wk == dest_alg && s2k wk == dest_s2k'
231 then return (KikiSuccess wk) 239 then return (KikiSuccess wk)
232 else maybe (decryptIt getpws) 240 else maybe (decryptIt getpws)
233 (return . KikiSuccess) 241 (return . KikiSuccess)
234 $ Map.lookup kk unkeys 242 $ Map.lookup (kk,dest_alg,dest_s2k') unkeys
235 243
236keyQueries :: Maybe String -> Map InputFile (StreamInfo,Message) -> (Maybe MappedPacket, Map KeyKey (OriginMapped Query)) 244keyQueries :: Maybe String -> Map InputFile (StreamInfo,Message) -> (Maybe MappedPacket, Map KeyKey (OriginMapped Query))
237keyQueries grip ringPackets = (mwk, fmap makeQuery keys) 245keyQueries grip ringPackets = (mwk, fmap makeQuery keys)