From b1579d82573b9d2ed12f396e510b590195c14aaf Mon Sep 17 00:00:00 2001 From: joe Date: Tue, 29 Apr 2014 00:45:37 -0400 Subject: rtRingAccess to resolve AutoAccess values. --- KeyRing.hs | 55 +++++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 39 insertions(+), 16 deletions(-) (limited to 'KeyRing.hs') 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 -- cgit v1.2.3