Switched cache update to lib/Keyring.hs interface.

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 ::
                            , [(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)