Verify cryptonomic self-auth for display.

2 files changed, 34 insertions, 19 deletions

diff --git a/kiki.hs b/kiki.hs
index 5bd6951..a1727e7 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -34,7 +34,7 @@ import Data.ByteArray.Encoding
 import qualified Codec.Archive.Tar as Tar
 import qualified Codec.Archive.Tar.Entry as Tar
 import Crypto.Hash.Algorithms (RIPEMD160(..))
-import Crypto.Hash
+import Crypto.Hash as C
 import Data.ByteArray (convert)
 import qualified Data.ByteString      as S
 import qualified Data.ByteString.Lazy as L
@@ -75,6 +75,30 @@ fpmatch grip key =
  where
     backend xs ys = and $ zipWith (==) (reverse xs) (reverse ys)
 
+subkeysForDomain "onion" subs = do
+        (code,(top,sub), kind, hashed,claimants) <- subs
+        guard ("tor" `elem` kind)
+        guard (code .&. 0x2 /= 0)
+        maybeToList $ derToBase32 <$> derRSA sub
+subkeysForDomain "ssh-rsa.cryptonomic.net" subs = do
+        (code,(top,sub), kind, hashed,claimants) <- subs
+        guard ("ssh-host" `elem` kind)
+        guard (code .&. 0x2 /= 0)
+        RSAKey (MPI n) (MPI e) <- maybeToList $ rsaKeyFromPacket sub
+        let blob = SSH.sshrsa e n
+            sha1 = C.hashlazy blob :: C.Digest C.SHA1
+            subdomain = convertToBase Base16 sha1
+        [ S8.unpack subdomain ]
+subkeysForDomain _ _ = []
+
+checkSelfAuthenticating parsed subs = do
+        let subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)]
+            len = L.length subdom0
+            subdom = Char8.unpack subdom0
+            match k = subdom == take (fromIntegral len) k
+        guard (len >= 16)
+        listToMaybe $ filter match $ subkeysForDomain (uid_topdomain parsed) subs
+
 listKeys :: [Packet] -> [Char]
 listKeys pkts = listKeysFiltered [] pkts
 
@@ -144,11 +168,6 @@ listKeysFiltered grips pkts = do
                         else showsigs claimants
         kcipher k = if isSecretKey k then " " ++ ciphername (symmetric_algorithm k)
                                      else ""
-        torkeys = do
-            (code,(top,sub), kind, hashed,claimants) <- subs
-            guard ("tor" `elem` kind)
-            guard (code .&. 0x2 /= 0)
-            maybeToList $ derToBase32 <$> derRSA sub
         uid = {- fromMaybe "" . listToMaybe $ -} do
             (keys,sigs) <- certs
             sig <- sigs
@@ -167,15 +186,9 @@ listKeysFiltered grips pkts = do
             let UserIDPacket uid = user_id sig
                 parsed = parseUID uid
                 ar = maybe " --> " (const " <-> ") $ do
-                        guard (uid_topdomain parsed == "onion" )
                         guard ( uid_realname parsed `elem` ["","Anonymous"])
                         guard (     uid_user parsed == "root" )
-                        let subdom0 = L.fromChunks [encodeUtf8 (uid_subdomain parsed)]
-                            len = L.length subdom0
-                            subdom = Char8.unpack subdom0
-                            match = (==subdom) . take (fromIntegral len)
-                        guard (len >= 16)
-                        listToMaybe $ filter match torkeys
+                        checkSelfAuthenticating parsed subs
             unlines $  (" " ++ ar ++ "@" ++ " " ++ uid_full parsed) : showsigs secondary
         -- (_,sigs) = unzip certs
     "master-key " ++ show (fingerprint top) ++ kcipher top ++ "\n" ++ uid ++"  ...\n" ++ subkeys ++ "\n"
@@ -410,8 +423,8 @@ bitcoinAddress network_id k = address
             Just (MPI y) = lookup 'y' (key k)
             pub = cannonical_eckey x y
             hsh = S.cons network_id . ripemd160 . sha256 . S.pack $ pub
-            sha256 x = convert (Crypto.Hash.hash x :: Digest SHA256) :: S.ByteString
-            ripemd160 x = convert (Crypto.Hash.hash x :: Digest RIPEMD160) :: S.ByteString
+            sha256 x = convert (C.hash x :: Digest SHA256) :: S.ByteString
+            ripemd160 x = convert (C.hash x :: Digest RIPEMD160) :: S.ByteString
             address = base58_encode hsh
 
 whoseKey :: RSAPublicKey -> KeyDB -> [KeyData]
diff --git a/lib/Transforms.hs b/lib/Transforms.hs
index 8a1da73..8adf6af 100644
--- a/lib/Transforms.hs
+++ b/lib/Transforms.hs
@@ -36,7 +36,7 @@ import Data.ASN1.Types (toASN1, ASN1Object, fromASN1, ASN1(Start, End, IntVal),
 
 import Data.ASN1.Encoding ( encodeASN1 )
 import qualified Data.Text as T ( Text, unpack, pack,
-        strip, reverse, drop, break, dropAround, length )
+        strip, reverse, drop, break, dropAround, length, breakOn )
 import Data.Text.Encoding ( encodeUtf8 )
 import Data.Bits              ((.|.), (.&.), Bits)
 
@@ -768,9 +768,11 @@ parseUID str = UserIDRecord {
     (T.strip-> realname, T.dropAround isBracket-> email)
                               = T.break (=='<') text
     (user, T.drop 1-> hostname) = T.break (=='@') email
-    ( T.reverse            -> topdomain,
-      T.reverse . T.drop 1 -> subdomain)
-                              = T.break (=='.') . T.reverse $ hostname
+    (topdomain, subdomain) =
+        case T.breakOn ".ssh-rsa.cryptonomic.net" hostname of
+            (s,".ssh-rsa.cryptonomic.net") -> ("ssh-rsa.cryptonomic.net", s)
+            _ -> (T.reverse *** T.reverse . T.drop 1)
+                  $ T.break (=='.') . T.reverse $ hostname
 
 selfAuthenticated :: OriginMapped Packet -> KeyData -> UidString -> Bool
 selfAuthenticated k kd (UidString str) =