Made tor signatures into tsign style signatures (TicId 8bafec)

1 files changed, 121 insertions, 18 deletions

diff --git a/kiki.hs b/kiki.hs
index 58806cb..c616445 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1124,7 +1124,8 @@ main = do
                 ws' = if null ws then [Nothing] else map Just ws
             v <- ws'
             return (sig,v)
-        has_self = not . null $ filter (\(sig,v) -> fmap topkey v == selfkey) vs
+        selfsigs = filter (\(sig,v) -> fmap topkey v == selfkey) vs
+        has_self = not . null $ selfsigs
         sigs' = if has_self
                     then sigs
                     {-
@@ -1158,7 +1159,10 @@ main = do
                                         ,"new_sig isSignaturePacket(over) = " ++ (show . map isSignaturePacket $ new_sig)
                                         ,"issuer = " ++ show (map signature_issuer new_sig)
                                         ])
-        new_sig = fst $ torsig g mainpubkey (fromJust selfkey) uid timestamp
+        flgs = if keykey mainpubkey == keykey (fromJust selfkey)
+                then keyFlags0 mainpubkey (map fst selfsigs)
+                else []
+        new_sig = fst $ torsig g mainpubkey (fromJust selfkey) uid timestamp flgs
 
         ys = uid:sigs'++xs''
 
@@ -1385,7 +1389,12 @@ main = do
                         torkey <- parsedkey
                         if key_usage cmd /= "tor"
                          then uids
-                         else let ps = makeTorUID (g::SystemRandom) timestamp wkun wk torkey
+                         else let ps = makeTorUID (g::SystemRandom) 
+                                                  timestamp
+                                                  wkun
+                                                  (keyFlags wkun uids)
+                                                  wk
+                                                  torkey
                                   toruid = head ps
                               in if toruid `elem` uids then uids else uids ++ ps 
         if not (null pks) 
@@ -1518,16 +1527,6 @@ newKey wkun wk parsedkey tag pre uids subkeys output_file grip = do
                              grip
                              timestamp
                              (g::SystemRandom)
-                sigpackets typ hashed unhashed = return $
-                    signaturePacket
-                        4 -- version
-                        typ -- 0x18 subkey binding sig, or 0x19 back-signature
-                        RSA
-                        SHA1
-                        hashed
-                        unhashed
-                        0 -- Word16 -- Left 16 bits of the signed hash value 
-                        [] -- [MPI]
 
                 hashed0 = 
                     [ KeyFlagsPacket 
@@ -1638,19 +1637,123 @@ seek_key (KeyUidMatch pat) ps = if null bs
 groupTops ps = groupBy (\_ b -> not (isTopKey b)) ps
 
 
-makeTorUID g timestamp wkun topkey torkey = uid:signatures_over sig
+makeTorUID g timestamp wkun keyflags 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
+    uid = UserIDPacket s
+    sig = fst $ torsig g topkey wkun uid timestamp keyflags
 
-torsig g topk wkun uid timestamp
+torsig g topk wkun uid timestamp extras
     = sign (Message [wkun])
                  (CertificationSignature (secretToPublic topk)
                                          uid
-                                         []) --fromJust wkun, uid])
+                                         (sigpackets 0x13 
+                                                     subpackets
+                                                     subpackets_unh))
                  SHA1
                  (fingerprint wkun) {- (fromJust wkgrip) -}
                  timestamp
                  g
+   where
+    subpackets = [ SignatureCreationTimePacket (fromIntegral timestamp)
+                 , TrustSignaturePacket 1 60
+                 , RegularExpressionPacket regex]
+                 ++ extras
+    subpackets_unh = [IssuerPacket (fingerprint wkun)]
+    -- <[^>]+[@.]asdf\.nowhere>$
+    regex = "<[^>]+[@.]"++hostname++">$"
+    -- regex = username ++ "@" ++ hostname
+    -- username = "[a-zA-Z0-9.][-a-zA-Z0-9.]*\\$?" :: String
+    hostname = subdomain' pu ++ "\\." ++ topdomain' pu
+    pu = parseUID uidstr where UserIDPacket uidstr = uid 
+    subdomain' = escape . T.unpack . uid_subdomain
+    topdomain' = escape . T.unpack . uid_topdomain
+    escape s = concatMap echar s
+      where
+        echar '|' = "\\|"
+        echar '*' = "\\*"
+        echar '+' = "\\+"
+        echar '?' = "\\?"
+        echar '.' = "\\."
+        echar '^' = "\\^"
+        echar '$' = "\\$"
+        echar '\\' = "\\\\"
+        echar '[' = "\\["
+        echar ']' = "\\]"
+        echar c = [c]
+
+sigpackets typ hashed unhashed = return $
+    signaturePacket
+        4 -- version
+        typ -- 0x18 subkey binding sig, or 0x19 back-signature
+        RSA
+        SHA1
+        hashed
+        unhashed
+        0 -- Word16 -- Left 16 bits of the signed hash value 
+        [] -- [MPI]
+
+keyFlags  wkun uids = keyFlags0 wkun (filter isSignaturePacket uids)
+ where
+    vs = map (verify (Message [wkun])) (signatures (Message (wkun:uids)))
+    ws = map signatures_over vs
+    xs = filter null ws
+
+keyFlags0 wkun uidsigs = concat
+                      [ keyflags
+                      , preferredsym
+                      , preferredhash
+                      , preferredcomp
+                      , features ]
+    
+ where
+    subs = concatMap hashed_subpackets uidsigs
+    keyflags = filterOr isflags subs $
+               KeyFlagsPacket { certify_keys = True
+                              , sign_data = True
+                              , encrypt_communication = False
+                              , encrypt_storage = False
+                              , split_key = False
+                              , authentication = False
+                              , group_key = False
+                              }
+    preferredsym = filterOr ispreferedsym subs $
+               PreferredSymmetricAlgorithmsPacket
+                              [ AES256
+                              , AES192
+                              , AES128
+                              , CAST5
+                              , TripleDES
+                              ]
+    preferredhash = filterOr ispreferedhash subs $
+               PreferredHashAlgorithmsPacket
+                              [ SHA256
+                              , SHA1
+                              , SHA384
+                              , SHA512
+                              , SHA224
+                              ]
+    preferredcomp = filterOr ispreferedcomp subs $
+               PreferredCompressionAlgorithmsPacket
+                              [ ZLIB
+                              , BZip2
+                              , ZIP
+                              ]
+    features = filterOr isfeatures subs $
+               FeaturesPacket { supports_mdc = True
+                              }
+
+    filterOr pred xs def = if null rs then [def] else rs where rs=filter pred xs
+
+    isflags (KeyFlagsPacket {}) = True
+    isflags _ = False
+    ispreferedsym (PreferredSymmetricAlgorithmsPacket {}) = True
+    ispreferedsym _ = False
+    ispreferedhash (PreferredHashAlgorithmsPacket {}) = True
+    ispreferedhash _ = False
+    ispreferedcomp (PreferredCompressionAlgorithmsPacket {}) = True
+    ispreferedcomp _ = False
+    isfeatures (FeaturesPacket {}) = True
+    isfeatures _ = False
+