diff options
author | joe <joe@jerkface.net> | 2016-08-30 02:28:41 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2016-08-30 02:28:41 -0400 |
commit | f82b12dc1701d311d6d5a3c9fbcab762e9c278af (patch) | |
tree | 6e881d766680946d033c627397fa7026a47c3448 /lib/KeyRing.hs | |
parent | fe847ffb3bd02fb661f1cb86532cee8186c1e82c (diff) |
Switched cache update to lib/Keyring.hs interface.
Diffstat (limited to 'lib/KeyRing.hs')
-rw-r--r-- | lib/KeyRing.hs | 20 |
1 files changed, 17 insertions, 3 deletions
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index 5cd5c71..5953f12 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs | |||
@@ -2395,12 +2395,16 @@ initializeMissingPEMFiles :: | |||
2395 | , [(FilePath,KikiReportAction)])) | 2395 | , [(FilePath,KikiReportAction)])) |
2396 | initializeMissingPEMFiles operation ctx grip mwk transcode db = do | 2396 | initializeMissingPEMFiles operation ctx grip mwk transcode db = do |
2397 | let decrypt = transcode (Unencrypted,S2K 100 "") | 2397 | let decrypt = transcode (Unencrypted,S2K 100 "") |
2398 | |||
2399 | -- nonexistants - files missing from disk. | ||
2398 | nonexistents <- | 2400 | nonexistents <- |
2399 | filterM (fmap not . doesFileExist . fst) | 2401 | filterM (fmap not . doesFileExist . fst) |
2400 | $ do (f,t) <- Map.toList (opFiles operation) | 2402 | $ do (f,t) <- Map.toList (opFiles operation) |
2401 | f <- resolveInputFile ctx f | 2403 | f <- resolveInputFile ctx f |
2402 | return (f,t) | 2404 | return (f,t) |
2403 | 2405 | ||
2406 | -- missing - mutable files not in the keyring and not on disk | ||
2407 | -- notmissing - mutable keys in the keyring, but not on disk | ||
2404 | let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do | 2408 | let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do |
2405 | (fname,stream) <- nonexistents | 2409 | (fname,stream) <- nonexistents |
2406 | let mutableTag | 2410 | let mutableTag |
@@ -2458,12 +2462,20 @@ initializeMissingPEMFiles operation ctx grip mwk transcode db = do | |||
2458 | try v $ \(db,import_rs) -> do | 2462 | try v $ \(db,import_rs) -> do |
2459 | 2463 | ||
2460 | -- generateInternals | 2464 | -- generateInternals |
2461 | let internals = mapMaybe getParams nonexistents | 2465 | let internals = mapMaybe getParams $ do |
2466 | (f,stream) <- nonexistents | ||
2467 | usage <- take 1 $ mapMaybe usageFromFilter [fill stream,spill stream] | ||
2468 | let (topspec,subspec) = parseSpec (fromMaybe "" grip) usage | ||
2469 | guard $ null $ do | ||
2470 | (kk,kd) <- filterMatches topspec $ Map.toList db | ||
2471 | subkeysForExport subspec kd | ||
2472 | return (f,stream) | ||
2462 | where | 2473 | where |
2463 | getParams (fname,stream) = | 2474 | getParams (fname,stream) = |
2464 | case initializer stream of | 2475 | case initializer stream of |
2465 | Internal p -> do _ <- internalInitializer stream | 2476 | Internal p -> do _ <- internalInitializer stream |
2466 | Just (p, stream) | 2477 | Just $ Right (p, stream) |
2478 | WarnMissing warning -> Just $ Left warning | ||
2467 | _ -> Nothing | 2479 | _ -> Nothing |
2468 | 2480 | ||
2469 | internalInitializer StreamInfo | 2481 | internalInitializer StreamInfo |
@@ -2471,7 +2483,8 @@ initializeMissingPEMFiles operation ctx grip mwk transcode db = do | |||
2471 | , spill = KF_Match tag } = Just tag | 2483 | , spill = KF_Match tag } = Just tag |
2472 | internalInitializer _ = Nothing | 2484 | internalInitializer _ = Nothing |
2473 | 2485 | ||
2474 | v <- generateInternals transcode mwk db internals | 2486 | mapM_ (hPutStrLn stderr) (lefts internals) |
2487 | v <- generateInternals transcode mwk db (rights internals) | ||
2475 | 2488 | ||
2476 | try v $ \(db,internals_rs) -> do | 2489 | try v $ \(db,internals_rs) -> do |
2477 | 2490 | ||
@@ -2656,6 +2669,7 @@ runKeyRing operation = do | |||
2656 | secring <- return Nothing | 2669 | secring <- return Nothing |
2657 | pubring <- return Nothing | 2670 | pubring <- return Nothing |
2658 | lks <- forM tolocks $ \f -> do | 2671 | lks <- forM tolocks $ \f -> do |
2672 | createDirectoryIfMissing True $ takeDirectory f | ||
2659 | lk <- dotlock_create f 0 | 2673 | lk <- dotlock_create f 0 |
2660 | v <- flip (maybe $ return Nothing) lk $ \lk -> do | 2674 | v <- flip (maybe $ return Nothing) lk $ \lk -> do |
2661 | e <- dotlock_take lk (-1) | 2675 | e <- dotlock_take lk (-1) |