summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs55
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
188 { access :: Access 188 { access :: Access
189 , typ :: FileType 189 , typ :: FileType
190 , fill :: KeyFilter 190 , fill :: KeyFilter
191 , spill :: KeyFilter 191 , spill :: KeyFilter -- ^ TODO: currently only respected for PEMFile.
192 -- Note that this is currently treated as a boolean
193 -- flag. KF_None means the file is not spillable
194 -- and anything else means that it is.
192 , initializer :: Maybe String } 195 , initializer :: Maybe String }
193 196
194 197
@@ -226,6 +229,7 @@ data KeyRingRuntime = KeyRingRuntime
226 , rtGrip :: Maybe String 229 , rtGrip :: Maybe String
227 , rtWorkingKey :: Maybe Packet 230 , rtWorkingKey :: Maybe Packet
228 , rtKeyDB :: KeyDB 231 , rtKeyDB :: KeyDB
232 , rtRingAccess :: Map.Map FilePath Access
229 } 233 }
230 234
231-- | TODO: Packet Update should have deletion action 235-- | TODO: Packet Update should have deletion action
@@ -961,22 +965,39 @@ writeHostsFiles krd secring pubring (hostdbs0,hostdbs,u1,gpgnames,outgoing_names
961 965
962buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet)) 966buildKeyDB :: (MappedPacket -> IO (KikiCondition Packet))
963 -> FilePath -> FilePath -> Maybe String -> KeyRingOperation 967 -> FilePath -> FilePath -> Maybe String -> KeyRingOperation
964 -> IO (KikiCondition ((KeyDB,Maybe String,Maybe MappedPacket, 968 -> IO (KikiCondition ((KeyDB
965 ([Hosts.Hosts], 969 ,Maybe String
970 ,Maybe MappedPacket
971 ,([Hosts.Hosts],
966 [Hosts.Hosts], 972 [Hosts.Hosts],
967 Hosts.Hosts, 973 Hosts.Hosts,
968 [(SockAddr, (KeyKey, KeyKey))], 974 [(SockAddr, (KeyKey, KeyKey))],
969 [SockAddr]) ) 975 [SockAddr])
976 ,Map.Map FilePath Access
977 )
970 ,[(FilePath,KikiReportAction)])) 978 ,[(FilePath,KikiReportAction)]))
971buildKeyDB doDecrypt secring pubring grip0 keyring = do 979buildKeyDB doDecrypt secring pubring grip0 keyring = do
972 let 980 let
973
974 files isring = do 981 files isring = do
975 (f,stream) <- Map.toList (kFiles keyring) 982 (f,stream) <- Map.toList (kFiles keyring)
976 guard (isring $ typ stream) 983 guard (isring $ typ stream)
977 resolveInputFile secring pubring f 984 resolveInputFile secring pubring f
978 985
979 readp n = fmap (n,) (readPacketsFromFile n) 986 filesAccs isring = do
987 (f,stream) <- Map.toList (kFiles keyring)
988 guard (isring $ typ stream)
989 n <- resolveInputFile secring pubring f
990 return (n, access stream)
991
992 readp (n,acc) = fmap readp0 $ readPacketsFromFile n
993 where
994 readp0 ps = ((n,acc'),ps)
995 where acc' = case acc of
996 AutoAccess ->
997 case ps of
998 Message ((PublicKeyPacket {}):_) -> Pub
999 Message ((SecretKeyPacket {}):_) -> Sec
1000 acc -> acc
980 1001
981 readw wk n = fmap (n,) (readPacketsFromWallet wk n) 1002 readw wk n = fmap (n,) (readPacketsFromWallet wk n)
982 1003
@@ -992,22 +1013,23 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do
992 return $ KikiSuccess (db'', report0 ++ report) 1013 return $ KikiSuccess (db'', report0 ++ report)
993 1014
994 -- KeyRings (todo: KikiCondition reporting?) 1015 -- KeyRings (todo: KikiCondition reporting?)
995 (db_rings,mwk,grip) <- do 1016 (db_rings,mwk,grip,accs) <- do
996 ms <- mapM readp (files isring) 1017 ms <- mapM readp (filesAccs isring)
997 let grip = grip0 `mplus` (fingerprint <$> fstkey) 1018 let grip = grip0 `mplus` (fingerprint <$> fstkey)
998 where 1019 where
999 fstkey = listToMaybe $ mapMaybe isSecringKey ms 1020 fstkey = listToMaybe $ mapMaybe isSecringKey ms
1000 where isSecringKey (fn,Message ps) 1021 where isSecringKey ((fn,_),Message ps)
1001 | fn==secring = listToMaybe ps 1022 | fn==secring = listToMaybe ps
1002 isSecringKey _ = Nothing 1023 isSecringKey _ = Nothing
1003 db_rings = foldl' (uncurry . merge) Map.empty ms 1024 db_rings = foldl' (\db ((fname,_),ps) -> merge db fname ps) Map.empty ms
1004 1025
1005 wk = listToMaybe $ do 1026 wk = listToMaybe $ do
1006 fp <- maybeToList grip 1027 fp <- maybeToList grip
1007 elm <- Map.toList db_rings 1028 elm <- Map.toList db_rings
1008 guard $ matchSpec (KeyGrip fp) elm 1029 guard $ matchSpec (KeyGrip fp) elm
1009 return $ keyMappedPacket (snd elm) 1030 return $ keyMappedPacket (snd elm)
1010 return (db_rings,wk,grip) 1031 accs = map fst ms
1032 return (db_rings,wk,grip,Map.fromList accs)
1011 1033
1012 let wk = fmap packet mwk 1034 let wk = fmap packet mwk
1013 1035
@@ -1043,7 +1065,7 @@ buildKeyDB doDecrypt secring pubring grip0 keyring = do
1043 r <- mergeHostFiles keyring db secring pubring 1065 r <- mergeHostFiles keyring db secring pubring
1044 try r $ \((db,hs),reportHosts) -> do 1066 try r $ \((db,hs),reportHosts) -> do
1045 1067
1046 return $ KikiSuccess ( (db, grip, mwk, hs), reportWallets ++ reportPEMs ) 1068 return $ KikiSuccess ( (db, grip, mwk, hs, accs), reportWallets ++ reportPEMs )
1047 1069
1048torhash :: Packet -> String 1070torhash :: Packet -> String
1049torhash key = fromMaybe "" $ derToBase32 <$> derRSA key 1071torhash key = fromMaybe "" $ derToBase32 <$> derRSA key
@@ -1373,7 +1395,8 @@ writeRingKeys krd rt {- db wk secring pubring -} = do
1373 importByExistingMaster kd@(KeyData p _ _ _) = 1395 importByExistingMaster kd@(KeyData p _ _ _) =
1374 fmap originallyPublic $ Map.lookup f $ locations p 1396 fmap originallyPublic $ Map.lookup f $ locations p
1375 d <- sortByHint f keyMappedPacket (Map.elems db) 1397 d <- sortByHint f keyMappedPacket (Map.elems db)
1376 only_public <- maybeToList $ wantedForFill (access stream) (fill stream) d 1398 acc <- maybeToList $ Map.lookup f (rtRingAccess rt)
1399 only_public <- maybeToList $ wantedForFill acc (fill stream) d
1377 case fill stream of 1400 case fill stream of
1378 KF_Match usage -> do grip <- maybeToList $ rtGrip rt 1401 KF_Match usage -> do grip <- maybeToList $ rtGrip rt
1379 flattenTop f only_public 1402 flattenTop f only_public
@@ -1708,9 +1731,8 @@ runKeyRing operation = do
1708 decrypt <- makeMemoizingDecrypter operation secring pubring 1731 decrypt <- makeMemoizingDecrypter operation secring pubring
1709 1732
1710 -- merge all keyrings, PEM files, and wallets 1733 -- merge all keyrings, PEM files, and wallets
1711 -- TODO: resolve AutoAccess here
1712 bresult <- buildKeyDB decrypt secring pubring grip0 operation 1734 bresult <- buildKeyDB decrypt secring pubring grip0 operation
1713 try' bresult $ \((db,grip,wk,hs),report_imports) -> do 1735 try' bresult $ \((db,grip,wk,hs,accs),report_imports) -> do
1714 1736
1715 externals_ret <- initializeMissingPEMFiles operation 1737 externals_ret <- initializeMissingPEMFiles operation
1716 secring pubring grip 1738 secring pubring grip
@@ -1724,6 +1746,7 @@ runKeyRing operation = do
1724 , rtGrip = grip 1746 , rtGrip = grip
1725 , rtWorkingKey = fmap packet wk 1747 , rtWorkingKey = fmap packet wk
1726 , rtKeyDB = db 1748 , rtKeyDB = db
1749 , rtRingAccess = accs
1727 } 1750 }
1728 1751
1729 r <- performManipulations decrypt 1752 r <- performManipulations decrypt