From 0a28ce3984ece343423f6ae3c1adbacbbb665d86 Mon Sep 17 00:00:00 2001 From: James Crayne Date: Sun, 20 Apr 2014 03:28:32 -0400 Subject: well, it builds --- KeyRing.hs | 56 ++++++++++++++++++++++++++++++++++++++++++++------------ 1 file changed, 44 insertions(+), 12 deletions(-) diff --git a/KeyRing.hs b/KeyRing.hs index 5e55565..4daa566 100644 --- a/KeyRing.hs +++ b/KeyRing.hs @@ -317,8 +317,6 @@ data KikiResult a = KikiResult keyPacket (KeyData k _ _ _) = packet k -keyMappedPacket (KeyData k _ _ _) = k - subkeyPacket (SubKey k _ ) = packet k subkeyMappedPacket (SubKey k _ ) = k @@ -1254,8 +1252,6 @@ runKeyRing operation = do try' bresult $ \((db,grip,wk),report_imports) -> do - let wkun = fmap (doDecrypt unkeysRef pws) wk - nonexistents <- filterM (fmap not . doesFileExist . fst) $ do (f,t) <- Map.toList (kFiles operation) @@ -1325,11 +1321,46 @@ runKeyRing operation = do try' externals_ret $ \(db,report_externals) -> do - db <- let perform kd (InducerSignature uid subpaks) = - -- makeInducerSig (keyPacket kd) wkun (UserIDPacket uid) subpaks - -- pgpSign + db <- let perform kd (InducerSignature uid subpaks) = do + case wk of + Nothing -> error "TODO no working key" -- todo + Just wk' -> do + wkun' <- doDecrypt unkeysRef pws wk' + case functorToEither wkun' of + Left e -> error "Bad passphrase, todo" + Right wkun -> do + let sigOver = makeInducerSig (keyPacket kd) wkun (UserIDPacket uid) subpaks + sigr <- pgpSign (Message [wkun]) sigOver SHA1 (fingerprint wkun) + let f ::([SigAndTrust],OriginMap) -> ([SigAndTrust],OriginMap) + f x = ( map ( (,Map.empty) . toMappedPacket om) (additional sigr) ++ fst x + , error "todo") + om = Map.singleton "--autosign" (origin p (-1)) where p = UserIDPacket uid + toMappedPacket om p = (mappedPacket "" p) {locations=om} + selfsigs = filter (\(sig,v,whosign) -> isJust (v >> Just wkun >>= guard + . (== keykey whosign) + . keykey)) vs + keys = map keyPacket $ Map.elems (rtKeyDB rt) + overs sig = signatures $ Message (keys++[keyPacket kd,UserIDPacket uid,sig]) + vs :: [ ( Packet -- signature + , Maybe SignatureOver -- Nothing means non-verified + , Packet ) -- key who signed + ] + vs = do + x <- maybeToList $ Map.lookup uid (rentryUids kd) + sig <- map (packet . fst) (fst x) + o <- overs sig + k <- keys + let ov = verify (Message [k]) $ o + signatures_over ov + return (sig,Just ov,k) + additional new_sig = do + new_sig <- maybeToList new_sig + guard (null $ selfsigs) + signatures_over new_sig + return kd { rentryUids = Map.adjust f uid (rentryUids kd) } + -- Maybe SignatureOver -> KeyData -- build keydata from pgpSign result - error "todo" + --error "todo" -- NOTEs -- {- @@ -1746,10 +1777,11 @@ data SubKey = SubKey MappedPacket [SigAndTrust] -- but we are keeping the name around until -- we're sure we wont be cutting and pasting -- code with master any more -data KeyData = KeyData MappedPacket -- main key - [SigAndTrust] -- sigs on main key - (Map.Map String ([SigAndTrust],OriginMap)) -- uids - (Map.Map KeyKey SubKey) -- subkeys +data KeyData = KeyData { keyMappedPacket :: MappedPacket -- main key + , rentrySigAndTrusts :: [SigAndTrust] -- sigs on main key + , rentryUids :: (Map.Map String ([SigAndTrust],OriginMap)) -- uids + , rentrySubKeys :: (Map.Map KeyKey SubKey) -- subkeys + } type KeyDB = Map.Map KeyKey KeyData -- cgit v1.2.3