Add tor uids and fixed autosign bug

1 files changed, 56 insertions, 20 deletions

diff --git a/kiki.hs b/kiki.hs
index 990e8e3..58806cb 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -59,9 +59,11 @@ unprefix c spec = if null (snd p) then swap p else (fst p, tail (snd p))
 
 
 data RSAPublicKey = RSAKey MPI MPI deriving Show
+data PKCS8_RSAPublicKey = RSAKey8 MPI MPI deriving Show
+
+pkcs8 (RSAKey n e) = RSAKey8 n e
 
 instance ASN1Object RSAPublicKey where
-    {-  
     -- PKCS #1 RSA Public Key
     toASN1 (RSAKey (MPI n) (MPI e))
                   = \xs -> Start Sequence
@@ -69,10 +71,13 @@ instance ASN1Object RSAPublicKey where
                          : IntVal e
                          : End Sequence
                          : xs
-    -}
+    fromASN1 _ =
+        Left "fromASN1: RSAPublicKey: unexpected format"
+
+instance ASN1Object PKCS8_RSAPublicKey where
 
     -- PKCS #8 Public key data
-    toASN1 (RSAKey (MPI n) (MPI e))
+    toASN1 (RSAKey8 (MPI n) (MPI e))
                   = \xs -> Start Sequence
                          : Start Sequence
                          : OID [1,2,840,113549,1,1,1]
@@ -85,7 +90,7 @@ instance ASN1Object RSAPublicKey where
             bs = encodeASN1' DER pubkey
 
     fromASN1 (Start Sequence:IntVal modulus:IntVal pubexp:End Sequence:xs) =
-        Right (RSAKey (MPI modulus) (MPI pubexp) , xs)
+        Right (RSAKey8 (MPI modulus) (MPI pubexp) , xs)
     fromASN1 (Start Sequence:Start Sequence:OID [1,2,840,113549,1,1,1]:End Sequence:BitString b:End Sequence:xs) =
         case decodeASN1' DER bs of
             Right as -> fromASN1 as
@@ -414,7 +419,7 @@ listKeysFiltered grips pkts = do
                         2 -> " <-- "
                         3 -> " <-> "
                 formkind = take kindcol $ defaultkind kind hashed ++ repeat ' '
-                -- torhash = maybe "" id $ derToBase32 <$> derRSA sub
+                torhash = maybe "" id $ derToBase32 <$> derRSA sub
             concat  [ " "
                     -- , grip top
                     , (if not (null claimants) 
@@ -779,7 +784,8 @@ data Arguments =
                  , files :: [FilePath]
                  }
         | DumpPackets { homedir :: Maybe FilePath
-                      , marshal_test :: String }
+                      , marshal_test :: String
+                      , files :: [FilePath] }
         {-
         | Decrypt { homedir :: Maybe FilePath
                   , passphrase_fd :: Maybe Int
@@ -1005,6 +1011,7 @@ main = do
             &= help "Merge multiple keyrings to stdout."
         , DumpPackets HOMEOPTION
               (def &= opt ("n" ::String))
+              (def &= args &= typFile)
             &= help "Output secret ring packets in ascii format for debugging."
         , Add HOMEOPTION
               (def &= opt ("passphrase"::String) 
@@ -1151,14 +1158,8 @@ main = do
                                         ,"new_sig isSignaturePacket(over) = " ++ (show . map isSignaturePacket $ new_sig)
                                         ,"issuer = " ++ show (map signature_issuer new_sig)
                                         ])
-        new_sig = fst $ sign (Message (maybeToList selfkey)) 
-                             (CertificationSignature mainpubkey
-                                                     uid
-                                                     []) --fromJust selfkey, uid])
-                             SHA1
-                             (fromJust grip)
-                             timestamp
-                             g
+        new_sig = fst $ torsig g mainpubkey (fromJust selfkey) uid timestamp
+
         ys = uid:sigs'++xs''
 
     doCmd cmd@(List {}) = do
@@ -1256,9 +1257,15 @@ main = do
           , sec   -- e3ozbhvej4jvlu43.onion/gpg/gnupghome/secring.gpg
           , grip  -- Just "AD1CA892FCF4ED9829C762269BDEA5B4D5643321"
           ) <- getPGPEnviron cmd
+        p <- case files cmd of
+                    [] -> return sec
+                    fs -> do 
+                            ms <- mapM readPacketsFromFile fs
+                            let unwrap (Message ps) = ps
+                            return (concatMap unwrap ms)
         if map toLower (marshal_test cmd) `elem` ["y","yes"]
-            then L.putStr $ encode (Message sec)
-            else putStrLn $ PP.ppShow sec
+            then L.putStr $ encode (Message p)
+            else putStrLn $ PP.ppShow p
 
     doCmd cmd@(MergeSecrets {}) = do
         ( homedir -- e3ozbhvej4jvlu43.onion/gpg/gnupghome
@@ -1316,7 +1323,7 @@ main = do
         when (not (null ys)) $ do
         let (_,ys') = seek_key (KeyTag wk sub) (tail ys) -- ambiguity check
             k = head ys
-            rsa = fromJust $ rsaKeyFromPacket k
+            rsa = pkcs8 . fromJust $ rsaKeyFromPacket k
             der = encodeASN1 DER (toASN1 rsa [])
             qq  = Base64.encode (L.unpack der)
             split64 [] = []
@@ -1372,9 +1379,18 @@ main = do
         let pkf = fingerprint (head parsedkey)
             (prepk,pks) = seek_key (KeyGrip pkf) subkeys'
 
+        g <- newGenIO
+        timestamp <- now
+        let uids' = do
+                        torkey <- parsedkey
+                        if key_usage cmd /= "tor"
+                         then uids
+                         else let ps = makeTorUID (g::SystemRandom) timestamp wkun wk torkey
+                                  toruid = head ps
+                              in if toruid `elem` uids then uids else uids ++ ps 
         if not (null pks) 
-            then existingKey (prepk,pks) remainder  wkun wk parsedkey (key_usage cmd) pre uids subkeys (output cmd) grip
-            else newKey                             wkun wk parsedkey (key_usage cmd) pre uids subkeys (output cmd) grip
+            then existingKey (prepk,pks) remainder  wkun wk parsedkey (key_usage cmd) pre uids' subkeys (output cmd) grip
+            else newKey                             wkun wk parsedkey (key_usage cmd) pre uids' subkeys (output cmd) grip
 
     doCmd cmd@(PemFP {}) = do
         let parseKeySpec hint spec = case break (==':') spec of
@@ -1383,7 +1399,9 @@ main = do
             (secfmt,secfile) = parseKeySpec 'S' $ seckey cmd
         Message seckey <- readKeyFromFile False secfmt secfile
         -- Message pubkey <- readKeyFromFile True  pubfmt pubfile
-        putStrLn $ fingerprint (head seckey)
+        -- Tor requires public key file... TODO
+        -- let torhash sub = maybe "" id $ derToBase32 <$> derRSA sub
+        putStrLn $ fingerprint (head seckey) -- ++ " " ++ torhash (head seckey)
 
 
 isSameKey a b = sort (key apub) == sort (key bpub)
@@ -1618,3 +1636,21 @@ seek_key (KeyUidMatch pat) ps = if null bs
     uidStr _                = ""
     
 groupTops ps = groupBy (\_ b -> not (isTopKey b)) ps
+
+
+makeTorUID g timestamp wkun topkey torkey = uid:signatures_over sig
+ where
+    torhash sub = maybe "" id $ derToBase32 <$> derRSA sub
+    s = "Anonymous <root@" ++ take 16 (torhash torkey) ++ ".onion>"
+    uid = UserIDPacket $ trace ("UID: "++s) s
+    sig = fst $ torsig g topkey wkun uid timestamp
+
+torsig g topk wkun uid timestamp
+    = sign (Message [wkun])
+                 (CertificationSignature (secretToPublic topk)
+                                         uid
+                                         []) --fromJust wkun, uid])
+                 SHA1
+                 (fingerprint wkun) {- (fromJust wkgrip) -}
+                 timestamp
+                 g