implemented --autosign for cross-merging master branch.

1 files changed, 87 insertions, 24 deletions

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