summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs88
1 files changed, 63 insertions, 25 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 6fa97d5..d500c26 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -117,6 +117,7 @@ data KeyRingRuntime = KeyRingRuntime
117 { rtPubring :: FilePath 117 { rtPubring :: FilePath
118 , rtSecring :: FilePath 118 , rtSecring :: FilePath
119 , rtGrip :: Maybe String 119 , rtGrip :: Maybe String
120 , rtWorkingKey :: Maybe Packet
120 , rtKeyDB :: KeyDB 121 , rtKeyDB :: KeyDB
121 } 122 }
122 123
@@ -124,11 +125,15 @@ data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a)
124 125
125data KeyRingData = KeyRingData 126data KeyRingData = KeyRingData
126 { kFiles :: Map.Map InputFile (RefType,FileType) 127 { kFiles :: Map.Map InputFile (RefType,FileType)
127 , kImports :: Map.Map FilePath (KeyData -> Maybe Bool) 128 , kImports :: Map.Map InputFile (KeyRingRuntime -> KeyData -> Maybe Bool)
128 -- ^ Indicates what pgp packets get written to which keyring files. 129 -- ^
130 -- Indicates what pgp master keys get written to which keyring files.
129 -- Just True = import public key 131 -- Just True = import public key
130 -- Just False = import secret key 132 -- Just False = import secret key
131 -- Nothing = do not import 133 -- Nothing = do not import
134 -- Note that subkeys will always be imported if their owner key is
135 -- already in the ring.
136 -- TODO: Even if their signatures are bad?
132 , homeSpec :: Maybe String 137 , homeSpec :: Maybe String
133 } 138 }
134 139
@@ -966,28 +971,57 @@ showPacket p | isKey p = (if is_subkey p
966showPacket0 p = concat . take 1 $ words (show p) 971showPacket0 p = concat . take 1 $ words (show p)
967 972
968 973
969writeRingKeys :: KeyRingData -> KeyDB -> Maybe Packet 974importPublic = Just True
975importSecret = Just False
976subkeysOnly = Nothing
977
978guardAuthentic :: KeyRingRuntime -> KeyData -> Maybe ()
979guardAuthentic rt keydata = guard (isauth rt keydata)
980
981isauth :: KeyRingRuntime -> KeyData -> Bool
982isauth rt keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk
983 where wk = workingKey (rtGrip rt) (rtKeyDB rt)
984 dont_have (KeyData p _ _ _) = not . Map.member (rtPubring rt)
985 $ locations p
986 has_good_sig wk (KeyData k sigs uids subs) = any goodsig $ Map.toList uids
987 where
988 goodsig (uidstr,(sigs,_)) = not . null $ do
989 sig0 <- fmap (packet . fst) sigs
990 pre_ov <- signatures (Message [packet k, UserIDPacket uidstr, sig0])
991 signatures_over $ verify (Message [wk]) pre_ov
992
993 workingKey grip use_db = listToMaybe $ do
994 fp <- maybeToList grip
995 elm <- Map.toList use_db
996 guard $ matchSpec (KeyGrip fp) elm
997 return $ keyPacket (snd elm)
998
999writeRingKeys :: KeyRingData -> KeyRingRuntime
1000 {-
1001 -> KeyDB -> Maybe Packet
970 -> FilePath -> FilePath 1002 -> FilePath -> FilePath
1003 -}
971 -> IO (KikiCondition [(FilePath,KikiReportAction)]) 1004 -> IO (KikiCondition [(FilePath,KikiReportAction)])
972writeRingKeys krd db wk secring pubring = do 1005writeRingKeys krd rt {- db wk secring pubring -} = do
973 let ks = Map.elems db 1006 let isring (KeyRingFile {}) = True
974 isring (KeyRingFile {}) = True
975 isring _ = False 1007 isring _ = False
976 fs = do 1008 db = rtKeyDB rt
977 (f,(rtyp,ftyp)) <- Map.toList (kFiles krd) 1009 wk = rtWorkingKey rt
978 guard (isring ftyp) 1010 secring = rtSecring rt
979 n <- resolveInputFile secring pubring f 1011 pubring = rtPubring rt
980 return (n,isMutable rtyp)
981 fromfile f kd@(KeyData p _ _ _) =
982 Map.member f $ locations p
983 let s = do 1012 let s = do
984 (f,mutable) <- fs 1013 (f,f0,mutable) <- do
1014 (f0,(rtyp,ftyp)) <- Map.toList (kFiles krd)
1015 guard (isring ftyp)
1016 f <- resolveInputFile secring pubring f0
1017 return (f,f0,isMutable rtyp)
985 let x = do 1018 let x = do
986 let wanted kd@(KeyData p _ _ _) 1019 let wanted kd@(KeyData p _ _ _)
987 = maybe (fmap originallyPublic $ Map.lookup f $ locations p) 1020 = mplus (fmap originallyPublic $ Map.lookup f $ locations p)
988 (\pred -> pred kd) 1021 $ do
989 (Map.lookup f $ kImports krd) 1022 pred <- Map.lookup f0 $ kImports krd
990 d <- sortByHint f keyMappedPacket ks 1023 pred rt kd
1024 d <- sortByHint f keyMappedPacket (Map.elems db)
991 only_public <- maybeToList $ wanted d 1025 only_public <- maybeToList $ wanted d
992 flattenTop f only_public d 1026 flattenTop f only_public d
993 new_packets = filter isnew x 1027 new_packets = filter isnew x
@@ -1244,23 +1278,25 @@ runKeyRing keyring = do
1244 return $ KikiSuccess (db, map (\((f,_,_,_),r)->(f,r)) rs 1278 return $ KikiSuccess (db, map (\((f,_,_,_),r)->(f,r)) rs
1245 ++ import_rs) 1279 ++ import_rs)
1246 1280
1281 let rt = KeyRingRuntime
1282 { rtPubring = pubring
1283 , rtSecring = secring
1284 , rtGrip = grip
1285 , rtWorkingKey = wk
1286 , rtKeyDB = db
1287 }
1288
1247 try' externals_ret $ \(db,report_externals) -> do 1289 try' externals_ret $ \(db,report_externals) -> do
1248 1290
1249 r <- writeWalletKeys keyring db wk 1291 r <- writeWalletKeys keyring db wk
1250 try' r $ \report_wallets -> do 1292 try' r $ \report_wallets -> do
1251 1293
1252 r <- writeRingKeys keyring db wk secring pubring 1294 r <- writeRingKeys keyring rt -- db wk secring pubring
1253 try' r $ \report_rings -> do 1295 try' r $ \report_rings -> do
1254 1296
1255 r <- writePEMKeys (doDecrypt unkeysRef pws) db exports 1297 r <- writePEMKeys (doDecrypt unkeysRef pws) db exports
1256 try' r $ \report_pems -> do 1298 try' r $ \report_pems -> do
1257 1299
1258 let rt = KeyRingRuntime
1259 { rtPubring = pubring
1260 , rtSecring = secring
1261 , rtGrip = grip
1262 , rtKeyDB = db
1263 }
1264 return $ KikiResult (KikiSuccess rt) 1300 return $ KikiResult (KikiSuccess rt)
1265 $ concat [ report_imports 1301 $ concat [ report_imports
1266 , report_externals 1302 , report_externals
@@ -2071,8 +2107,10 @@ syncWallet = todo
2071usePassphraseFD :: Int -> Kiki () 2107usePassphraseFD :: Int -> Kiki ()
2072usePassphraseFD = todo 2108usePassphraseFD = todo
2073 2109
2110{-
2074importAll :: Kiki () 2111importAll :: Kiki ()
2075importAll = todo 2112importAll = todo
2113-}
2076 2114
2077importAllAuthentic :: Kiki () 2115importAllAuthentic :: Kiki ()
2078importAllAuthentic = todo 2116importAllAuthentic = todo