diff options
-rw-r--r-- | KeyRing.hs | 88 | ||||
-rw-r--r-- | kiki.hs | 11 |
2 files changed, 73 insertions, 26 deletions
@@ -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 | ||
125 | data KeyRingData = KeyRingData | 126 | data 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 | |||
966 | showPacket0 p = concat . take 1 $ words (show p) | 971 | showPacket0 p = concat . take 1 $ words (show p) |
967 | 972 | ||
968 | 973 | ||
969 | writeRingKeys :: KeyRingData -> KeyDB -> Maybe Packet | 974 | importPublic = Just True |
975 | importSecret = Just False | ||
976 | subkeysOnly = Nothing | ||
977 | |||
978 | guardAuthentic :: KeyRingRuntime -> KeyData -> Maybe () | ||
979 | guardAuthentic rt keydata = guard (isauth rt keydata) | ||
980 | |||
981 | isauth :: KeyRingRuntime -> KeyData -> Bool | ||
982 | isauth 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 | |||
999 | writeRingKeys :: KeyRingData -> KeyRingRuntime | ||
1000 | {- | ||
1001 | -> KeyDB -> Maybe Packet | ||
970 | -> FilePath -> FilePath | 1002 | -> FilePath -> FilePath |
1003 | -} | ||
971 | -> IO (KikiCondition [(FilePath,KikiReportAction)]) | 1004 | -> IO (KikiCondition [(FilePath,KikiReportAction)]) |
972 | writeRingKeys krd db wk secring pubring = do | 1005 | writeRingKeys 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 | |||
2071 | usePassphraseFD :: Int -> Kiki () | 2107 | usePassphraseFD :: Int -> Kiki () |
2072 | usePassphraseFD = todo | 2108 | usePassphraseFD = todo |
2073 | 2109 | ||
2110 | {- | ||
2074 | importAll :: Kiki () | 2111 | importAll :: Kiki () |
2075 | importAll = todo | 2112 | importAll = todo |
2113 | -} | ||
2076 | 2114 | ||
2077 | importAllAuthentic :: Kiki () | 2115 | importAllAuthentic :: Kiki () |
2078 | importAllAuthentic = todo | 2116 | importAllAuthentic = todo |
@@ -1334,6 +1334,14 @@ main = do | |||
1334 | wallets | 1334 | wallets |
1335 | rings = map (\fname -> (ArgFile fname, (MutableRef Nothing, KeyRingFile passfd))) | 1335 | rings = map (\fname -> (ArgFile fname, (MutableRef Nothing, KeyRingFile passfd))) |
1336 | keyrings_ | 1336 | keyrings_ |
1337 | importStyle = maybe (\_ _ -> subkeysOnly) | ||
1338 | (\f rt kd -> f rt kd >> importPublic) | ||
1339 | $ mplus import_f importifauth_f | ||
1340 | where | ||
1341 | import_f = do Map.lookup "--import" margs | ||
1342 | return $ \rt kd -> Just () | ||
1343 | importifauth_f = do Map.lookup "--import-if-authentic" margs | ||
1344 | return guardAuthentic | ||
1337 | kikiOp = KeyRingData | 1345 | kikiOp = KeyRingData |
1338 | { kFiles = Map.fromList $ | 1346 | { kFiles = Map.fromList $ |
1339 | [ ( HomeSec, (MutableRef Nothing, KeyRingFile passfd) ) | 1347 | [ ( HomeSec, (MutableRef Nothing, KeyRingFile passfd) ) |
@@ -1342,7 +1350,8 @@ main = do | |||
1342 | ++ rings | 1350 | ++ rings |
1343 | ++ pems | 1351 | ++ pems |
1344 | ++ walts | 1352 | ++ walts |
1345 | , kImports = Map.empty | 1353 | , kImports = Map.fromList $ |
1354 | [ ( HomePub, importStyle ) ] | ||
1346 | , homeSpec = homespec | 1355 | , homeSpec = homespec |
1347 | } | 1356 | } |
1348 | 1357 | ||