well, it builds

1 files 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