autosign support

2 files changed, 29 insertions, 7 deletions

diff --git a/KeyRing.hs b/KeyRing.hs
index 49a6069..a15fdeb 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -1360,11 +1360,13 @@ performManipulations doDecrypt operation rt wk = do
         flip (maybe $ return NoWorkingKey) wk $ \wk' -> do
         wkun' <- doDecrypt wk'
         try wkun' $ \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
-                  , om `Map.union` snd x )
+        let flgs = if keykey (keyPacket kd) == keykey wkun
+                    then keyFlags0 (keyPacket kd) (map (\(x,_,_)->x) selfsigs)
+                    else []
+            sigOver = makeInducerSig (keyPacket kd)
+                                     wkun
+                                     (UserIDPacket uid)
+                                     $ flgs ++ subpaks
             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
@@ -1388,6 +1390,10 @@ performManipulations doDecrypt operation rt wk = do
                 new_sig <- maybeToList new_sig
                 guard (null $ selfsigs)
                 signatures_over new_sig
+        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
+                  , om `Map.union` snd x )
         return $ KikiSuccess $ kd { rentryUids = Map.adjust f uid (rentryUids kd) }
 
 initializeMissingPEMFiles ::
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)