summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-05-06 01:40:43 -0400
committerjoe <joe@jerkface.net>2014-05-06 01:40:43 -0400
commit94efc2744b7d6288dd08b7e3f74337345ae0efb0 (patch)
tree4c3f3f52c4f1e0461a43d99e737afe3afa4d5c24
parent9cf8e1743d4c8039d36b13b7cecf6413fd80c9ad (diff)
reporting for per-file transformations
-rw-r--r--KeyRing.hs26
1 files changed, 13 insertions, 13 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 023c027..ffd8183 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -266,21 +266,20 @@ data StreamInfo = StreamInfo { access :: Access
266 -- 'WalletFile': 266 -- 'WalletFile':
267 -- 267 --
268 -- * The 'spill' setting is ignored and the file's contents are shared. 268 -- * The 'spill' setting is ignored and the file's contents are shared.
269 -- (TODO) 269 -- (TODO)
270 -- 270 --
271 -- 'Hosts': 271 -- 'Hosts':
272 -- 272 --
273 -- * The 'spill' setting is ignored and the file's contents are shared. 273 -- * The 'spill' setting is ignored and the file's contents are shared.
274 -- (TODO) 274 -- (TODO)
275 -- 275 --
276 , initializer :: Maybe String 276 , initializer :: Maybe String
277 -- ^ If 'typ' is 'PEMFile' and an 'initializer' string is set, then it is 277 -- ^ If 'typ' is 'PEMFile' and an 'initializer' string is set, then it is
278 -- interpretted as a shell command that may be used to create the key if it 278 -- interpretted as a shell command that may be used to create the key if it
279 -- does not exist. 279 -- does not exist.
280 , transforms :: [Transform] 280 , transforms :: [Transform]
281 -- ^ Ignored. TODO: The intention is that we may indicate per-file 281 -- ^ Per-file transformations that occur before the contents of a file are
282 -- transformations that occur before the contents of a file are spilled 282 -- spilled into the common pool.
283 -- into the common pool.
284 } 283 }
285 284
286 285
@@ -1274,19 +1273,20 @@ buildKeyDB ctx grip0 keyring = do
1274 , rtRingAccess = accs 1273 , rtRingAccess = accs
1275 , rtKeyDB = Map.empty 1274 , rtKeyDB = Map.empty
1276 } 1275 }
1277 transformed <- 1276 transformed0 <-
1278 let trans f (info,ps) = do 1277 let trans f (info,ps) = do
1279 let manip = combineTransforms (transforms info) 1278 let manip = combineTransforms (transforms info)
1280 rt1 = rt0 { rtKeyDB = merge Map.empty f ps } 1279 rt1 = rt0 { rtKeyDB = merge Map.empty f ps }
1281 acc = True 1280 acc = Just Sec /= Map.lookup f accs
1282 r <- performManipulations doDecrypt rt1 mwk manip 1281 r <- performManipulations doDecrypt rt1 mwk manip
1283 return $ either (const (info,ps)) 1282 try r $ \(rt2,report) -> do
1284 (\(rt2,report) -> (info,flattenKeys acc $ rtKeyDB rt2)) 1283 return $ KikiSuccess (report,(info,flattenKeys acc $ rtKeyDB rt2))
1285 $ functorToEither r 1284 in fmap sequenceA $ Map.traverseWithKey trans spilled
1286 in Map.traverseWithKey trans spilled 1285 try transformed0 $ \transformed -> do
1287 let db_rings = Map.foldlWithKey' mergeIt Map.empty transformed 1286 let db_rings = Map.foldlWithKey' mergeIt Map.empty transformed
1288 where 1287 where
1289 mergeIt db f (info,ps) = merge db f ps 1288 mergeIt db f (_,(info,ps)) = merge db f ps
1289 reportTrans = concat $ Map.elems $ fmap fst transformed
1290 1290
1291 -- Wallets 1291 -- Wallets
1292 let importWalletKey wk db' (top,fname,sub,tag) = do 1292 let importWalletKey wk db' (top,fname,sub,tag) = do
@@ -1332,7 +1332,7 @@ buildKeyDB ctx grip0 keyring = do
1332 try r $ \((db,hs),reportHosts) -> do 1332 try r $ \((db,hs),reportHosts) -> do
1333 1333
1334 return $ KikiSuccess ( (db, grip, mwk, hs, accs, doDecrypt, unspilled) 1334 return $ KikiSuccess ( (db, grip, mwk, hs, accs, doDecrypt, unspilled)
1335 , reportWallets ++ reportPEMs ) 1335 , reportTrans ++ reportWallets ++ reportPEMs ++ reportHosts )
1336 1336
1337torhash :: Packet -> String 1337torhash :: Packet -> String
1338torhash key = fromMaybe "" $ derToBase32 <$> derRSA key 1338torhash key = fromMaybe "" $ derToBase32 <$> derRSA key