diff options
-rw-r--r-- | KeyRing.hs | 56 |
1 files changed, 44 insertions, 12 deletions
@@ -317,8 +317,6 @@ data KikiResult a = KikiResult | |||
317 | 317 | ||
318 | keyPacket (KeyData k _ _ _) = packet k | 318 | keyPacket (KeyData k _ _ _) = packet k |
319 | 319 | ||
320 | keyMappedPacket (KeyData k _ _ _) = k | ||
321 | |||
322 | subkeyPacket (SubKey k _ ) = packet k | 320 | subkeyPacket (SubKey k _ ) = packet k |
323 | subkeyMappedPacket (SubKey k _ ) = k | 321 | subkeyMappedPacket (SubKey k _ ) = k |
324 | 322 | ||
@@ -1254,8 +1252,6 @@ runKeyRing operation = do | |||
1254 | 1252 | ||
1255 | try' bresult $ \((db,grip,wk),report_imports) -> do | 1253 | try' bresult $ \((db,grip,wk),report_imports) -> do |
1256 | 1254 | ||
1257 | let wkun = fmap (doDecrypt unkeysRef pws) wk | ||
1258 | |||
1259 | nonexistents <- | 1255 | nonexistents <- |
1260 | filterM (fmap not . doesFileExist . fst) | 1256 | filterM (fmap not . doesFileExist . fst) |
1261 | $ do (f,t) <- Map.toList (kFiles operation) | 1257 | $ do (f,t) <- Map.toList (kFiles operation) |
@@ -1325,11 +1321,46 @@ runKeyRing operation = do | |||
1325 | 1321 | ||
1326 | try' externals_ret $ \(db,report_externals) -> do | 1322 | try' externals_ret $ \(db,report_externals) -> do |
1327 | 1323 | ||
1328 | db <- let perform kd (InducerSignature uid subpaks) = | 1324 | db <- let perform kd (InducerSignature uid subpaks) = do |
1329 | -- makeInducerSig (keyPacket kd) wkun (UserIDPacket uid) subpaks | 1325 | case wk of |
1330 | -- pgpSign | 1326 | Nothing -> error "TODO no working key" -- todo |
1327 | Just wk' -> do | ||
1328 | wkun' <- doDecrypt unkeysRef pws wk' | ||
1329 | case functorToEither wkun' of | ||
1330 | Left e -> error "Bad passphrase, todo" | ||
1331 | Right wkun -> do | ||
1332 | let sigOver = makeInducerSig (keyPacket kd) wkun (UserIDPacket uid) subpaks | ||
1333 | sigr <- pgpSign (Message [wkun]) sigOver SHA1 (fingerprint wkun) | ||
1334 | let f ::([SigAndTrust],OriginMap) -> ([SigAndTrust],OriginMap) | ||
1335 | f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x | ||
1336 | , error "todo") | ||
1337 | om = Map.singleton "--autosign" (origin p (-1)) where p = UserIDPacket uid | ||
1338 | toMappedPacket om p = (mappedPacket "" p) {locations=om} | ||
1339 | selfsigs = filter (\(sig,v,whosign) -> isJust (v >> Just wkun >>= guard | ||
1340 | . (== keykey whosign) | ||
1341 | . keykey)) vs | ||
1342 | keys = map keyPacket $ Map.elems (rtKeyDB rt) | ||
1343 | overs sig = signatures $ Message (keys++[keyPacket kd,UserIDPacket uid,sig]) | ||
1344 | vs :: [ ( Packet -- signature | ||
1345 | , Maybe SignatureOver -- Nothing means non-verified | ||
1346 | , Packet ) -- key who signed | ||
1347 | ] | ||
1348 | vs = do | ||
1349 | x <- maybeToList $ Map.lookup uid (rentryUids kd) | ||
1350 | sig <- map (packet . fst) (fst x) | ||
1351 | o <- overs sig | ||
1352 | k <- keys | ||
1353 | let ov = verify (Message [k]) $ o | ||
1354 | signatures_over ov | ||
1355 | return (sig,Just ov,k) | ||
1356 | additional new_sig = do | ||
1357 | new_sig <- maybeToList new_sig | ||
1358 | guard (null $ selfsigs) | ||
1359 | signatures_over new_sig | ||
1360 | return kd { rentryUids = Map.adjust f uid (rentryUids kd) } | ||
1361 | -- Maybe SignatureOver -> KeyData | ||
1331 | -- build keydata from pgpSign result | 1362 | -- build keydata from pgpSign result |
1332 | error "todo" | 1363 | --error "todo" |
1333 | -- NOTEs | 1364 | -- NOTEs |
1334 | -- | 1365 | -- |
1335 | {- | 1366 | {- |
@@ -1746,10 +1777,11 @@ data SubKey = SubKey MappedPacket [SigAndTrust] | |||
1746 | -- but we are keeping the name around until | 1777 | -- but we are keeping the name around until |
1747 | -- we're sure we wont be cutting and pasting | 1778 | -- we're sure we wont be cutting and pasting |
1748 | -- code with master any more | 1779 | -- code with master any more |
1749 | data KeyData = KeyData MappedPacket -- main key | 1780 | data KeyData = KeyData { keyMappedPacket :: MappedPacket -- main key |
1750 | [SigAndTrust] -- sigs on main key | 1781 | , rentrySigAndTrusts :: [SigAndTrust] -- sigs on main key |
1751 | (Map.Map String ([SigAndTrust],OriginMap)) -- uids | 1782 | , rentryUids :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids |
1752 | (Map.Map KeyKey SubKey) -- subkeys | 1783 | , rentrySubKeys :: (Map.Map KeyKey SubKey) -- subkeys |
1784 | } | ||
1753 | 1785 | ||
1754 | type KeyDB = Map.Map KeyKey KeyData | 1786 | type KeyDB = Map.Map KeyKey KeyData |
1755 | 1787 | ||