summaryrefslogtreecommitdiff
path: root/lib/KeyRing.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2016-08-30 02:28:41 -0400
committerjoe <joe@jerkface.net>2016-08-30 02:28:41 -0400
commitf82b12dc1701d311d6d5a3c9fbcab762e9c278af (patch)
tree6e881d766680946d033c627397fa7026a47c3448 /lib/KeyRing.hs
parentfe847ffb3bd02fb661f1cb86532cee8186c1e82c (diff)
Switched cache update to lib/Keyring.hs interface.
Diffstat (limited to 'lib/KeyRing.hs')
-rw-r--r--lib/KeyRing.hs20
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)]))
2396initializeMissingPEMFiles operation ctx grip mwk transcode db = do 2396initializeMissingPEMFiles 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)