From f82b12dc1701d311d6d5a3c9fbcab762e9c278af Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 30 Aug 2016 02:28:41 -0400 Subject: Switched cache update to lib/Keyring.hs interface. --- lib/KeyRing.hs | 20 +++++++++++++++++--- lib/Kiki.hs | 29 +++++++++++++++++++++++++++-- lib/Types.hs | 3 ++- 3 files changed, 46 insertions(+), 6 deletions(-) (limited to 'lib') 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 :: , [(FilePath,KikiReportAction)])) initializeMissingPEMFiles operation ctx grip mwk transcode db = do let decrypt = transcode (Unencrypted,S2K 100 "") + + -- nonexistants - files missing from disk. nonexistents <- filterM (fmap not . doesFileExist . fst) $ do (f,t) <- Map.toList (opFiles operation) f <- resolveInputFile ctx f return (f,t) + -- missing - mutable files not in the keyring and not on disk + -- notmissing - mutable keys in the keyring, but not on disk let (missing,notmissing) = partition (\(_,_,ns,_)->null (ns >>= snd)) $ do (fname,stream) <- nonexistents let mutableTag @@ -2458,12 +2462,20 @@ initializeMissingPEMFiles operation ctx grip mwk transcode db = do try v $ \(db,import_rs) -> do -- generateInternals - let internals = mapMaybe getParams nonexistents + let internals = mapMaybe getParams $ do + (f,stream) <- nonexistents + usage <- take 1 $ mapMaybe usageFromFilter [fill stream,spill stream] + let (topspec,subspec) = parseSpec (fromMaybe "" grip) usage + guard $ null $ do + (kk,kd) <- filterMatches topspec $ Map.toList db + subkeysForExport subspec kd + return (f,stream) where getParams (fname,stream) = case initializer stream of Internal p -> do _ <- internalInitializer stream - Just (p, stream) + Just $ Right (p, stream) + WarnMissing warning -> Just $ Left warning _ -> Nothing internalInitializer StreamInfo @@ -2471,7 +2483,8 @@ initializeMissingPEMFiles operation ctx grip mwk transcode db = do , spill = KF_Match tag } = Just tag internalInitializer _ = Nothing - v <- generateInternals transcode mwk db internals + mapM_ (hPutStrLn stderr) (lefts internals) + v <- generateInternals transcode mwk db (rights internals) try v $ \(db,internals_rs) -> do @@ -2656,6 +2669,7 @@ runKeyRing operation = do secring <- return Nothing pubring <- return Nothing lks <- forM tolocks $ \f -> do + createDirectoryIfMissing True $ takeDirectory f lk <- dotlock_create f 0 v <- flip (maybe $ return Nothing) lk $ \lk -> do 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 return $ PassphraseSpec Nothing Nothing pfd passwordop = KeyRingOperation { opFiles = Map.empty - -- TODO: ask agent for new passphrase , opPassphrases = main_passwds , opHome = homespec , opTransforms = [] @@ -390,7 +389,30 @@ refreshCache rt rootdir = do wkkd = rtKeyDB rt Map.! keykey wk getSecret tag = sortOn (Down . timestamp) $ getSubkeys Unsigned wk (keySubKeys wkkd) tag - + exportOp = withOutgoing $ minimalOp (CommonArgsParsed (Just $ takeDirectory $ rtPubring rt) + Nothing) + where + withOutgoing op = op + { opFiles = opFiles op `Map.union` Map.fromList outgoing_secrets + , opPassphrases = [PassphraseMemoizer (rtPassphrases rt)] + } + outgoing_secrets = + [ send "ipsec" (mkpath "ipsec.d/private/" ++ Char8.unpack oname++".pem") "missing ipsec key?" + , send "ssh-client" (mkpath "root/.ssh/id_rsa") "missing ssh-client key?" + , send "ssh-server" (mkpath "ssh_host_rsa_key") "missing ssh host key?" + , send "tor" (mkpath "tor/private_key") "missing tor key?" + ] + send usage path warning = + ( ArgFile path, StreamInfo { typ = PEMFile + , fill = KF_Match usage + , spill = KF_None + , access = Sec + , initializer = WarnMissing warning + , transforms = [] + }) + KikiResult rt' report <- runKeyRing exportOp + + {- let writeSecret tag path warning = do let my_ks :: [Packet] my_ks = getSecret tag @@ -425,6 +447,7 @@ refreshCache rt rootdir = do writeSecret "tor" (mkpath "tor/private_key") "missing tor key?" + -} -- Finally, export public keys if they do not exist. either warn (write $ mkpath "root/.ssh/id_rsa.pub") @@ -561,6 +584,7 @@ sshblobFromPacket k = blob bs = SSH.keyblob (n,e) blob = Char8.unpack bs +{- replaceSshServerKeys root cmn = do let homepass' = cmn { cap_homespec = fmap root (cap_homespec cmn) } replaceSSH op = op { opFiles = files } @@ -578,6 +602,7 @@ replaceSshServerKeys root cmn = do "" -> Nothing pth -> Just pth err -> hPutStrLn stderr $ errorString err +-} slash :: String -> String -> String slash "/" ('/':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 | WalletFile | DNSPresentation | Hosts + | SshFile deriving (Eq,Ord,Enum,Show) -- type UsageTag = String -data Initializer = NoCreate | Internal GenerateKeyParams | External String +data Initializer = NoCreate | Internal GenerateKeyParams | External String | WarnMissing String deriving (Eq,Ord,Show) -- cgit v1.2.3