From 768eef43fc1e19175a3b3f6820f96910d3f2a4b7 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 21 Apr 2014 18:41:52 -0400 Subject: autosign support --- kiki.hs | 20 ++++++++++++++++++-- 1 file changed, 18 insertions(+), 2 deletions(-) (limited to 'kiki.hs') diff --git a/kiki.hs b/kiki.hs index 0d87b90..d1d8bb3 100644 --- a/kiki.hs +++ b/kiki.hs @@ -1157,7 +1157,7 @@ main = do ++ hosts , kImports = Map.fromList $ [ ( HomePub, importStyle ) ] - , kManip = noManip + , kManip = maybe noManip (const doAutosign) $ Map.lookup "--autosign" margs , homeSpec = homespec } @@ -1183,6 +1183,22 @@ main = do return() where + doAutosign rt kd@(KeyData k ksigs umap submap) = ops + where + ops = map (\u -> InducerSignature u []) us + us = filter torStyle $ Map.keys umap + torbindings = getTorKeys (map packet $ flattenTop "" True kd) + torStyle str = and [ uid_topdomain parsed == "onion" + , uid_realname parsed `elem` ["","Anonymous"] + , uid_user parsed == "root" + , fmap (match . fst) (lookup (packet k) 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) + getTorKeys pub = do xs <- groupBindings pub (_,(top,sub),us,_,_) <- xs @@ -1244,7 +1260,7 @@ main = do o <- overs sig k <- keys let ov = verify (Message [k]) $ o - signatures_over ov + take 1 $ signatures_over ov return (sig,Just ov,k) selfsigs = filter (\(sig,v,whosign) -> isJust (v >> selfkey >>= guard . (== keykey whosign) -- cgit v1.2.3