rtRingAccess to resolve AutoAccess values.

1 files changed, 39 insertions, 16 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 09fa19c..f7b4ec8 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -188,7 +188,10 @@ data StreamInfo = StreamInfo
     { access :: Access
     , typ :: FileType
     , fill :: KeyFilter
-    , spill :: KeyFilter
+    , spill :: KeyFilter -- ^ TODO: currently only respected for PEMFile.
+                         -- Note that this is currently treated as a boolean
+                         -- flag.  KF_None means the file is not spillable
+                         -- and anything else means that it is.
     , initializer :: Maybe String }
 
 
@@ -226,6 +229,7 @@ data KeyRingRuntime = KeyRingRuntime
                         , rtGrip :: Maybe String
                         , rtWorkingKey :: Maybe Packet
                         , rtKeyDB :: KeyDB
+                        , rtRingAccess :: Map.Map FilePath Access
                         }
 
 -- | TODO: Packet Update should have deletion action
@@ -961,22 +965,39 @@ writeHostsFiles krd secring pubring (hostdbs0,hostdbs,u1,gpgnames,outgoing_names
 
 buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet))
               -> FilePath -> FilePath -> Maybe String -> KeyRingOperation
-              -> IO (KikiCondition ((KeyDB,Maybe String,Maybe MappedPacket,
-                                      ([Hosts.Hosts],
+              -> IO (KikiCondition ((KeyDB
+                                    ,Maybe String
+                                    ,Maybe MappedPacket
+                                    ,([Hosts.Hosts],
                                              [Hosts.Hosts],
                                              Hosts.Hosts,
                                              [(SockAddr, (KeyKey, KeyKey))],
-                                             [SockAddr]) )
+                                             [SockAddr])
+                                    ,Map.Map FilePath Access
+                                    )
                                    ,[(FilePath,KikiReportAction)]))
 buildKeyDB doDecrypt secring pubring grip0 keyring = do
-    let
-
+    let 
         files isring = do
             (f,stream) <- Map.toList (kFiles keyring)
             guard (isring $ typ stream)
             resolveInputFile secring pubring f
 
-        readp n = fmap (n,) (readPacketsFromFile n)
+        filesAccs isring = do
+            (f,stream) <- Map.toList (kFiles keyring)
+            guard (isring $ typ stream)
+            n <- resolveInputFile secring pubring f
+            return (n, access stream)
+
+        readp (n,acc) = fmap readp0 $ readPacketsFromFile n
+         where
+          readp0 ps = ((n,acc'),ps)
+           where acc' = case acc of
+                            AutoAccess ->
+                                case ps of
+                                    Message ((PublicKeyPacket {}):_) -> Pub
+                                    Message ((SecretKeyPacket {}):_) -> Sec
+                            acc -> acc
 
         readw wk n = fmap (n,) (readPacketsFromWallet wk n)
 
@@ -992,22 +1013,23 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do
             return $ KikiSuccess (db'', report0 ++ report)
 
     -- KeyRings (todo: KikiCondition reporting?)
-    (db_rings,mwk,grip) <- do
-        ms <- mapM readp (files isring)
+    (db_rings,mwk,grip,accs) <- do
+        ms <- mapM readp (filesAccs isring)
         let grip = grip0 `mplus` (fingerprint <$> fstkey)
               where
                 fstkey = listToMaybe $ mapMaybe isSecringKey ms
-                          where isSecringKey (fn,Message ps)
+                          where isSecringKey ((fn,_),Message ps)
                                     | fn==secring = listToMaybe ps
                                 isSecringKey _  = Nothing
-            db_rings = foldl' (uncurry . merge) Map.empty ms
+            db_rings = foldl' (\db ((fname,_),ps) -> merge db fname ps) Map.empty ms
 
             wk = listToMaybe $ do
                     fp <- maybeToList grip
                     elm <- Map.toList db_rings
                     guard $ matchSpec (KeyGrip fp) elm
                     return $ keyMappedPacket (snd elm)
-        return (db_rings,wk,grip)
+            accs = map fst ms
+        return (db_rings,wk,grip,Map.fromList accs)
 
     let wk = fmap packet mwk
 
@@ -1043,7 +1065,7 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do
     r <- mergeHostFiles keyring db secring pubring
     try r $ \((db,hs),reportHosts) -> do
 
-    return $ KikiSuccess ( (db, grip, mwk, hs), reportWallets ++ reportPEMs )
+    return $ KikiSuccess ( (db, grip, mwk, hs, accs), reportWallets ++ reportPEMs )
 
 torhash :: Packet -> String
 torhash key = fromMaybe "" $ derToBase32 <$> derRSA key
@@ -1373,7 +1395,8 @@ writeRingKeys krd rt {- db wk secring pubring -} = do
                     importByExistingMaster kd@(KeyData p _ _ _) =
                         fmap originallyPublic $ Map.lookup f $ locations p
                 d <- sortByHint f keyMappedPacket (Map.elems db)
-                only_public <- maybeToList $ wantedForFill (access stream) (fill stream) d
+                acc <- maybeToList $ Map.lookup f (rtRingAccess rt)
+                only_public <- maybeToList $ wantedForFill acc (fill stream) d
                 case fill stream of
                     KF_Match usage -> do grip <- maybeToList $ rtGrip rt
                                          flattenTop f only_public
@@ -1708,9 +1731,8 @@ runKeyRing operation = do
         decrypt <- makeMemoizingDecrypter operation secring pubring
 
         -- merge all keyrings, PEM files, and wallets
-        -- TODO: resolve AutoAccess here
         bresult <- buildKeyDB decrypt secring pubring grip0 operation
-        try' bresult $ \((db,grip,wk,hs),report_imports) -> do
+        try' bresult $ \((db,grip,wk,hs,accs),report_imports) -> do
 
         externals_ret <- initializeMissingPEMFiles operation
                                                    secring pubring grip
@@ -1724,6 +1746,7 @@ runKeyRing operation = do
                        , rtGrip = grip
                        , rtWorkingKey = fmap packet wk
                        , rtKeyDB = db
+                       , rtRingAccess = accs
                        }
 
         r <- performManipulations decrypt