From 24cdfd9a26ba1617765cad4ab36967d9cede714c Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Sun, 3 May 2020 14:56:03 -0400
Subject: Verify cryptonomic self-auth for display.

---
 kiki.hs | 43 ++++++++++++++++++++++++++++---------------
 1 file changed, 28 insertions(+), 15 deletions(-)

(limited to 'kiki.hs')

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]
-- 
cgit v1.2.3