diff options
Diffstat (limited to 'kiki.hs')
-rw-r--r-- | kiki.hs | 62 |
1 files changed, 25 insertions, 37 deletions
@@ -1269,7 +1269,7 @@ sortByHint fname f = sortBy (comparing gethint) | |||
1269 | keyMappedPacket (KeyData k _ _ _) = k | 1269 | keyMappedPacket (KeyData k _ _ _) = k |
1270 | keyPacket (KeyData k _ _ _) = packet k | 1270 | keyPacket (KeyData k _ _ _) = packet k |
1271 | 1271 | ||
1272 | writeOutKeyrings :: Map.Map FilePath DotLock -> KeyDB -> IO () | 1272 | writeOutKeyrings :: Map.Map FilePath t -> KeyDB -> IO () |
1273 | writeOutKeyrings lkmap db = do | 1273 | writeOutKeyrings lkmap db = do |
1274 | let ks = Map.elems db | 1274 | let ks = Map.elems db |
1275 | fs = Map.keys (foldr unionfiles Map.empty ks) | 1275 | fs = Map.keys (foldr unionfiles Map.empty ks) |
@@ -1307,44 +1307,34 @@ writeOutKeyrings lkmap db = do | |||
1307 | L.writeFile f (encode m) | 1307 | L.writeFile f (encode m) |
1308 | 1308 | ||
1309 | cross_merge doDecrypt homespec keyrings wallets f = do | 1309 | cross_merge doDecrypt homespec keyrings wallets f = do |
1310 | |||
1311 | let it = KeyRingData | ||
1312 | { filesToLock = HomeSec:HomePub:map ArgFile keyrings | ||
1313 | , homeSpec = homespec | ||
1314 | , keyringFiles = keyrings | ||
1315 | , walletFiles = wallets | ||
1316 | , kaction = go | ||
1317 | } | ||
1318 | runKeyRing it | ||
1319 | where | ||
1320 | go rt = do | ||
1310 | let readp n = fmap (n,) (readPacketsFromFile n) | 1321 | let readp n = fmap (n,) (readPacketsFromFile n) |
1311 | readw wk n = fmap (n,) (readPacketsFromWallet wk n) | 1322 | readw wk n = fmap (n,) (readPacketsFromWallet wk n) |
1312 | 1323 | ||
1313 | let relock keyrings = do | 1324 | let pass n = do |
1314 | (fsns,failed_locks) <- lockFiles keyrings | 1325 | ms <- mapM readp (rtRings rt) |
1315 | (wsns,failed_wlocks) <- lockFiles wallets | 1326 | let db0 = foldl' (uncurry . merge) Map.empty ms |
1316 | forM_ (failed_locks++failed_wlocks) $ \f -> warn $ "Failed to lock: " ++ f | ||
1317 | return (fsns,wsns,failed_locks,failed_wlocks) | ||
1318 | sec_n:_ = keyrings | ||
1319 | |||
1320 | (homedir,secring,pubring,grip0) <- getHomeDir homespec | ||
1321 | |||
1322 | (fsns0,wsns0,failed_locks0,failed_wlocks0) <- relock [secring,pubring] | ||
1323 | db00 <- do | ||
1324 | ms0 <- mapM readp (map snd fsns0++failed_locks0) | ||
1325 | return $ foldl' (uncurry . merge) Map.empty ms0 | ||
1326 | |||
1327 | (fsns,wsns,failed_locks,failed_wlocks) <- relock keyrings | ||
1328 | wsns <- return $ wsns0 ++ wsns | ||
1329 | failed_locks <- return $ failed_locks0 ++ failed_locks | ||
1330 | failed_wlocks <- return $ failed_wlocks0 ++ failed_wlocks | ||
1331 | |||
1332 | -- let (lks,fs) = unzip fsns | ||
1333 | -- forM_ fs $ \f -> warn $ "locked: " ++ f | ||
1334 | let pass n (fsns,failed_locks) = do | ||
1335 | ms <- mapM readp (map snd fsns++failed_locks) | ||
1336 | let db0 = foldl' (uncurry . merge) db00 ms | ||
1337 | fstkey = listToMaybe $ mapMaybe isSecringKey ms | 1327 | fstkey = listToMaybe $ mapMaybe isSecringKey ms |
1338 | where isSecringKey (fn,Message ps) | 1328 | where isSecringKey (fn,Message ps) |
1339 | | fn==sec_n = listToMaybe ps | 1329 | | fn== rtSecring rt = listToMaybe ps |
1340 | isSecringKey _ = Nothing | 1330 | isSecringKey _ = Nothing |
1341 | grip = grip0 `mplus` (fingerprint <$> fstkey) | 1331 | grip = rtGrip rt `mplus` (fingerprint <$> fstkey) |
1342 | wk = listToMaybe $ do | 1332 | wk = listToMaybe $ do |
1343 | fp <- maybeToList grip | 1333 | fp <- maybeToList grip |
1344 | elm <- Map.toList db0 | 1334 | elm <- Map.toList db0 |
1345 | guard $ matchSpec (KeyGrip fp) elm | 1335 | guard $ matchSpec (KeyGrip fp) elm |
1346 | return $ keyPacket (snd elm) | 1336 | return $ keyPacket (snd elm) |
1347 | wms <- mapM (readw wk) (map snd wsns++failed_wlocks) | 1337 | wms <- mapM (readw wk) (rtWallets rt) |
1348 | let -- db1= foldl' (uncurry . merge_) db0 wms | 1338 | let -- db1= foldl' (uncurry . merge_) db0 wms |
1349 | ts = do | 1339 | ts = do |
1350 | maybeToList wk | 1340 | maybeToList wk |
@@ -1373,7 +1363,7 @@ cross_merge doDecrypt homespec keyrings wallets f = do | |||
1373 | return (tag,mp) | 1363 | return (tag,mp) |
1374 | 1364 | ||
1375 | -- export wallet keys | 1365 | -- export wallet keys |
1376 | forM_ wsns $ \(_,n) -> do | 1366 | forM_ (rtWallets rt) $ \n -> do |
1377 | let cs' = do | 1367 | let cs' = do |
1378 | (nw,mp) <- cs | 1368 | (nw,mp) <- cs |
1379 | -- let fns = Map.keys (locations mp) | 1369 | -- let fns = Map.keys (locations mp) |
@@ -1389,19 +1379,17 @@ cross_merge doDecrypt homespec keyrings wallets f = do | |||
1389 | 1379 | ||
1390 | -- unlockFiles fsns ----------- Originally, I did this to enable altering the gpg keyrings | 1380 | -- unlockFiles fsns ----------- Originally, I did this to enable altering the gpg keyrings |
1391 | ------------------------------- from external tools. | 1381 | ------------------------------- from external tools. |
1392 | (db',_) <- f (sec_n,grip) db pubring | 1382 | (db',_) <- f (rtSecring rt,grip) db (rtPubring rt) |
1393 | -- lk <- relock --------------- The design is not quite safe, so it is disabled for now. | 1383 | -- lk <- relock --------------- The design is not quite safe, so it is disabled for now. |
1394 | let lk = (fsns,failed_locks) -- | 1384 | let lk = (rtRings rt,[]) |
1395 | ------------------------------- | 1385 | ------------------------------- |
1396 | maybe (if n==0 then pass 1 lk else return (lk,db)) | 1386 | maybe (if n==0 then pass 1 else return (lk,db)) |
1397 | (return . (lk,)) | 1387 | (return . (lk,)) |
1398 | db' | 1388 | db' |
1399 | ((fsns,failed_locks),db) <- pass 0 (fsns,failed_locks) | 1389 | ((fsns,failed_locks),db) <- pass 0 |
1400 | let lkmap = Map.fromList $ map swap fsns | 1390 | |
1391 | let lkmap = Map.fromList $ map (,()) fsns | ||
1401 | writeOutKeyrings lkmap db | 1392 | writeOutKeyrings lkmap db |
1402 | unlockFiles fsns | ||
1403 | unlockFiles wsns | ||
1404 | return () | ||
1405 | 1393 | ||
1406 | 1394 | ||
1407 | {- | 1395 | {- |