summaryrefslogtreecommitdiff
path: root/lib
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
parentfe847ffb3bd02fb661f1cb86532cee8186c1e82c (diff)
Switched cache update to lib/Keyring.hs interface.
Diffstat (limited to 'lib')
-rw-r--r--lib/KeyRing.hs20
-rw-r--r--lib/Kiki.hs29
-rw-r--r--lib/Types.hs3
3 files changed, 46 insertions, 6 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)
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 70d5ed6..d5b3457 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -199,7 +199,6 @@ importAndRefresh root cmn cipher = do
199 return $ PassphraseSpec Nothing Nothing pfd 199 return $ PassphraseSpec Nothing Nothing pfd
200 passwordop = KeyRingOperation 200 passwordop = KeyRingOperation
201 { opFiles = Map.empty 201 { opFiles = Map.empty
202 -- TODO: ask agent for new passphrase
203 , opPassphrases = main_passwds 202 , opPassphrases = main_passwds
204 , opHome = homespec 203 , opHome = homespec
205 , opTransforms = [] 204 , opTransforms = []
@@ -390,7 +389,30 @@ refreshCache rt rootdir = do
390 wkkd = rtKeyDB rt Map.! keykey wk 389 wkkd = rtKeyDB rt Map.! keykey wk
391 getSecret tag = sortOn (Down . timestamp) 390 getSecret tag = sortOn (Down . timestamp)
392 $ getSubkeys Unsigned wk (keySubKeys wkkd) tag 391 $ getSubkeys Unsigned wk (keySubKeys wkkd) tag
393 392 exportOp = withOutgoing $ minimalOp (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt)
393 Nothing)
394 where
395 withOutgoing op = op
396 { opFiles = opFiles op `Map.union` Map.fromList outgoing_secrets
397 , opPassphrases = [PassphraseMemoizer (rtPassphrases rt)]
398 }
399 outgoing_secrets =
400 [ send "ipsec" (mkpath "ipsec.d/private/" ++ Char8.unpack oname++".pem") "missing ipsec key?"
401 , send "ssh-client" (mkpath "root/.ssh/id_rsa") "missing ssh-client key?"
402 , send "ssh-server" (mkpath "ssh_host_rsa_key") "missing ssh host key?"
403 , send "tor" (mkpath "tor/private_key") "missing tor key?"
404 ]
405 send usage path warning =
406 ( ArgFile path, StreamInfo { typ = PEMFile
407 , fill = KF_Match usage
408 , spill = KF_None
409 , access = Sec
410 , initializer = WarnMissing warning
411 , transforms = []
412 })
413 KikiResult rt' report <- runKeyRing exportOp
414
415 {-
394 let writeSecret tag path warning = do 416 let writeSecret tag path warning = do
395 let my_ks :: [Packet] 417 let my_ks :: [Packet]
396 my_ks = getSecret tag 418 my_ks = getSecret tag
@@ -425,6 +447,7 @@ refreshCache rt rootdir = do
425 writeSecret "tor" 447 writeSecret "tor"
426 (mkpath "tor/private_key") 448 (mkpath "tor/private_key")
427 "missing tor key?" 449 "missing tor key?"
450 -}
428 451
429 -- Finally, export public keys if they do not exist. 452 -- Finally, export public keys if they do not exist.
430 either warn (write $ mkpath "root/.ssh/id_rsa.pub") 453 either warn (write $ mkpath "root/.ssh/id_rsa.pub")
@@ -561,6 +584,7 @@ sshblobFromPacket k = blob
561 bs = SSH.keyblob (n,e) 584 bs = SSH.keyblob (n,e)
562 blob = Char8.unpack bs 585 blob = Char8.unpack bs
563 586
587{-
564replaceSshServerKeys root cmn = do 588replaceSshServerKeys root cmn = do
565 let homepass' = cmn { cap_homespec = fmap root (cap_homespec cmn) } 589 let homepass' = cmn { cap_homespec = fmap root (cap_homespec cmn) }
566 replaceSSH op = op { opFiles = files } 590 replaceSSH op = op { opFiles = files }
@@ -578,6 +602,7 @@ replaceSshServerKeys root cmn = do
578 "" -> Nothing 602 "" -> Nothing
579 pth -> Just pth 603 pth -> Just pth
580 err -> hPutStrLn stderr $ errorString err 604 err -> hPutStrLn stderr $ errorString err
605-}
581 606
582slash :: String -> String -> String 607slash :: String -> String -> String
583slash "/" ('/':xs) = '/':xs 608slash "/" ('/':xs) = '/':xs
diff --git a/lib/Types.hs b/lib/Types.hs
index 767ee98..86836e0 100644
--- a/lib/Types.hs
+++ b/lib/Types.hs
@@ -159,10 +159,11 @@ data FileType = KeyRingFile
159 | WalletFile 159 | WalletFile
160 | DNSPresentation 160 | DNSPresentation
161 | Hosts 161 | Hosts
162 | SshFile
162 deriving (Eq,Ord,Enum,Show) 163 deriving (Eq,Ord,Enum,Show)
163 164
164-- type UsageTag = String 165-- type UsageTag = String
165data Initializer = NoCreate | Internal GenerateKeyParams | External String 166data Initializer = NoCreate | Internal GenerateKeyParams | External String | WarnMissing String
166 deriving (Eq,Ord,Show) 167 deriving (Eq,Ord,Show)
167 168
168 169