diff options
author | joe <joe@jerkface.net> | 2014-05-06 01:40:43 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2014-05-06 01:40:43 -0400 |
commit | 94efc2744b7d6288dd08b7e3f74337345ae0efb0 (patch) | |
tree | 4c3f3f52c4f1e0461a43d99e737afe3afa4d5c24 /KeyRing.hs | |
parent | 9cf8e1743d4c8039d36b13b7cecf6413fd80c9ad (diff) |
reporting for per-file transformations
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 26 |
1 files changed, 13 insertions, 13 deletions
@@ -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 | ||
1337 | torhash :: Packet -> String | 1337 | torhash :: Packet -> String |
1338 | torhash key = fromMaybe "" $ derToBase32 <$> derRSA key | 1338 | torhash key = fromMaybe "" $ derToBase32 <$> derRSA key |