From d19d1b8e1b640e3776c4bc2b0936b69b4d9bbad9 Mon Sep 17 00:00:00 2001 From: joe Date: Fri, 6 Dec 2013 20:31:59 -0500 Subject: implemented --autosign for cross-merging master branch. --- kiki.hs | 111 ++++++++++++++++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 87 insertions(+), 24 deletions(-) (limited to 'kiki.hs') diff --git a/kiki.hs b/kiki.hs index 171319a..b5f87cd 100644 --- a/kiki.hs +++ b/kiki.hs @@ -1679,6 +1679,26 @@ main = do use_db <- foldM (doImport decrypt) use_db0 (map snd imports) (ret_db,_) <- foldM (doExport decrypt) (Just use_db,use_db) (map snd exports) + use_db <- + flip (maybe $ return use_db) + (lookup "--autosign" $ map (\(x:xs)->(x,xs)) sargs) + $ \_ -> do + let keys = map undata $ Map.elems use_db + wk = listToMaybe $ do + fp <- maybeToList grip + elm <- Map.toList use_db + guard $ matchSpec (KeyGrip fp) elm + return $ undata (snd elm) + + undata (KeyData p _ _ _) = packet p + g <- newGenIO + stamp <- now + wkun <- flip (maybe $ return Nothing) wk $ \wk -> do + wkun <- decrypt wk + maybe (error $ "Bad passphrase?") (return . Just) wkun + return . snd $ Map.mapAccum (signTorIds stamp wkun keys) g use_db + ret_db <- return $ fmap (const use_db) ret_db + flip (maybe $ return ()) ret_db . const $ do -- On last pass, interpret --show-* commands. let shspec = Map.fromList [("--show-wk", const $ show_wk secfile grip) @@ -1759,36 +1779,79 @@ main = do where w0:ws = pub + signTorIds timestamp selfkey keys + g kd@(KeyData k ksigs umap submap) = (g', KeyData k ksigs umap' submap) + where + _ = g :: SystemRandom + mkey = packet k + (g',umap') = Map.mapAccumWithKey signIfTor g umap + signIfTor g str ps = if isTorID str then {- trace (unlines + [ "Found tor id: " + ++show (str,fmap fingerprint selfkey) + , "additional = " ++ intercalate "," (map showPacket additional) + ]) -} + (g',ps') + else (g,ps) + where + uidxs0 = map packet $ flattenUid "" True (str,ps) + om = Map.singleton "--autosign" (origin p (-1)) where p = UserIDPacket str + tmap = Map.empty + ps' = ( map ( (,tmap) . flip MappedPacket om) additional + ++ fst ps + , Map.union om (snd ps) ) + + (uidxs, additional, xs'',g') = signSelfAuthTorKeys' selfkey g keys grip timestamp mkey uidxs0 + torbindings = getTorKeys (map packet $ flattenTop "" True kd) + isTorID str = and [ uid_topdomain parsed == "onion" + , uid_realname parsed `elem` ["","Anonymous"] + , uid_user parsed == "root" + , fmap (match . fst) (lookup mkey torbindings) + == Just True ] + where parsed = parseUID str + match = ( (==subdom) . take (fromIntegral len)) + subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)] + subdom = Char8.unpack subdom0 + len = T.length (uid_subdomain parsed) + signSelfAuthTorKeys selfkey g sec grip timestamp xs = ys where keys = filter isKey sec mainpubkey = fst (head xs) - uid:xs' = map snd xs + uidxs0 = map snd xs + (uidxs, additional, xs'',g') = signSelfAuthTorKeys' selfkey g keys grip timestamp mainpubkey uidxs0 + ys = uidxs++ additional++xs'' + + signSelfAuthTorKeys' selfkey g keys grip timestamp mainpubkey (uid:xs') = (uid:sigs,additional,xs'',g') + where (sigs, xs'') = span isSignaturePacket xs' - overs sig = signatures $ Message (keys++[uid,sig]) + overs sig = signatures $ Message (keys++[mainpubkey,uid,sig]) vs :: [ ( Packet -- signature - , Maybe SignatureOver) -- Nothing means non-verified + , Maybe SignatureOver -- Nothing means non-verified + , Packet ) -- key who signed ] vs = do sig <- sigs - let vs = overs sig >>= return . verify (Message keys) - ws = filter (not . null . signatures_over) vs - ws' = if null ws then [Nothing] else map Just ws - v <- ws' - return (sig,v) - selfsigs = filter (\(sig,v) -> fmap topkey v == selfkey) vs - has_self = not . null $ selfsigs - sigs' = if has_self - then sigs - {- - else trace ( "key params: "++params (fromJust selfkey)++"\n" - ++traceSig (topkey new_sig) - (user_id new_sig) - (signatures_over new_sig)) - sigs - ++ {- map modsig -} (signatures_over new_sig) - -} - else sigs ++ signatures_over new_sig + o <- overs sig + k <- keys + let ov = verify (Message [k]) $ o + signatures_over ov + return (sig,Just ov,k) + {- + mainsigs = filter (\(sig,v,whosign) -> isJust (v >> Just mainpubkey >>= guard + . (== keykey whosign) + . keykey)) + vs + -} + selfsigs = filter (\(sig,v,whosign) -> isJust (v >> selfkey >>= guard + . (== keykey whosign) + . keykey)) + vs + additional = do + guard $ {- trace (unlines $ [ "selfsigs = "++show (map ((\(_,_,k)->fingerprint k)) selfsigs) + , " for mainkey = "++fingerprint mainpubkey] ) + -} + (null $ selfsigs) + signatures_over new_sig modsig sig = sig { signature = map id (signature sig) } where plus1 (MPI x) = MPI (x+1) params newtop = public ++ map fst (key newtop) ++ "}" @@ -1812,11 +1875,11 @@ main = do ,"issuer = " ++ show (map signature_issuer new_sig) ]) flgs = if keykey mainpubkey == keykey (fromJust selfkey) - then keyFlags0 mainpubkey (map fst selfsigs) + then keyFlags0 mainpubkey (map (\(x,_,_)->x) selfsigs) else [] - new_sig = fst $ torsig g mainpubkey (fromJust selfkey) uid timestamp flgs + (new_sig,g') = torsig g mainpubkey (fromJust selfkey) uid timestamp flgs - ys = uid:sigs'++xs'' + -- ys = uid:sigs++ additional++xs'' {- doCmd cmd@(List {}) = do -- cgit v1.2.3