From 142352043699520d3cc3f1c6f1ff4fba585014a8 Mon Sep 17 00:00:00 2001
From: Joe Crayne <joe@jerkface.net>
Date: Sat, 13 Jul 2019 06:19:11 -0400
Subject: Avoid external call to ssh-keygen.

---
 kiki.hs       |  2 ++
 lib/Kiki.hs   | 24 +++++++++++++++++-------
 lib/SSHKey.hs | 15 ++++++++-------
 3 files changed, 27 insertions(+), 14 deletions(-)

diff --git a/kiki.hs b/kiki.hs
index a8f1bc6..fb4b878 100644
--- a/kiki.hs
+++ b/kiki.hs
@@ -1218,6 +1218,7 @@ kiki "show" args = do
                    , ("--pem",1)
                    , ("--dns",1)
                    , ("--ssh",1)
+                   , ("--sshfp",1)
                    , ("--wip",1)
                    , ("--cert",1)
                    , ("--torhash",1)
@@ -1270,6 +1271,7 @@ kiki "show" args = do
                                       ,("--pem",\[x] -> show_pem x $ fromMaybe "" grip)
                                       ,("--dns",\[x] -> show_dns x $ fromMaybe "" grip)
                                       ,("--ssh",\[x] -> show_ssh x $ fromMaybe "" grip)
+                                      ,("--sshfp",\[x] -> show_sshfp x $ fromMaybe "" grip)
                                       ,("--wip",\[x] -> show_wip x $ fromMaybe "" grip)
                                       ,("--cert",\[x] -> show_cert x $ fromMaybe "" grip)
                                       ,("--torhash",\[x] -> show_torhash x)
diff --git a/lib/Kiki.hs b/lib/Kiki.hs
index 324efc4..1cc387b 100644
--- a/lib/Kiki.hs
+++ b/lib/Kiki.hs
@@ -13,6 +13,7 @@ import           Codec.Encryption.OpenPGP.ASCIIArmor.Types
 import           Control.Applicative
 import           Control.Exception
 import           Control.Monad
+import qualified Crypto.Hash as C
 import           Data.ASN1.BinaryEncoding
 import           Data.ASN1.Encoding
 import           Data.ASN1.Types
@@ -37,6 +38,7 @@ import           System.Posix.Types         (FileMode)
 import           System.Posix.IO            as Posix (createPipe)
 import           System.Posix.User
 #if defined(VERSION_memory)
+import           Data.ByteArray (convert)
 import           Data.ByteArray.Encoding
 import qualified Data.ByteString.Char8      as S8
 #elif defined(VERSION_dataenc)
@@ -582,14 +584,15 @@ writePublicKeyFiles rt fw grip myId = do
     installIpsecConf fw myId cs
     fileWriterCommit fw
 
-sshKeyToHostname :: Packet -> IO Char8.ByteString
+
+sshKeyToHostname :: Applicative m => Packet -> m Char8.ByteString
 sshKeyToHostname sshkey = do
-  (_, (sout, _serr)) <- runExternal shellScript (Just $ sshblobFromPacket sshkey)
-  return $ Char8.fromChunks [sout]
-  where
-    shellScript =
-      "f=$(mktemp) && cat > \"$f\" && ssh-keygen -r _ -f \"$f\"  |" ++
-      " (read _ _ _ _ _ hash _ && echo -n $hash.ssh.cryptonomic.net); r=$?; rm -f \"$f\"; exit $r"
+  case rsaKeyFromPacket sshkey of
+    Just (RSAKey (MPI n) (MPI e)) -> do
+        let blob = SSH.sshrsa e n
+            sha1 = C.hashlazy blob :: C.Digest C.SHA1
+        pure $ Char8.fromStrict (convertToBase Base16 sha1) <> ".ssh.cryptonomic.net"
+    Nothing   -> pure ""
 
 peerConnectionName :: Peer -> Char8.ByteString
 peerConnectionName = coerce . peerAddress
@@ -653,6 +656,13 @@ show_pem' keyspec wkgrip db keyfmt = do
 warn :: String -> IO ()
 warn str = hPutStrLn stderr str
 
+show_sshfp :: String -> String -> KeyDB -> IO ()
+show_sshfp keyspec wkgrip db = do
+    let s = parseSpec wkgrip keyspec
+    case selectPublicKey s db of
+        Nothing -> hPutStrLn stderr $ keyspec ++ ": not found"
+        Just k  -> Char8.putStrLn =<< sshKeyToHostname k
+
 show_ssh :: String -> String -> KeyDB -> IO ()
 show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db
 
diff --git a/lib/SSHKey.hs b/lib/SSHKey.hs
index bd47169..0ded986 100644
--- a/lib/SSHKey.hs
+++ b/lib/SSHKey.hs
@@ -22,6 +22,14 @@ import LengthPrefixedBE
 
 type Key = (Integer,Integer)
 
+
+sshrsa :: Integer -> Integer -> L.ByteString
+sshrsa e n = runPut $ do
+    putWord32be 7
+    putByteString "ssh-rsa"
+    put (LengthPrefixedBE e)
+    put (LengthPrefixedBE n)
+
 keyblob :: Key -> L.ByteString
 keyblob (n,e) = "ssh-rsa " <> blob
  where
@@ -32,13 +40,6 @@ keyblob (n,e) = "ssh-rsa " <> blob
     blob = L8.pack $ Base64.encode (L.unpack bs)
 #endif
 
-    sshrsa :: Integer -> Integer -> L.ByteString
-    sshrsa e n = runPut $ do
-        putWord32be 7
-        putByteString "ssh-rsa"
-        put (LengthPrefixedBE e)
-        put (LengthPrefixedBE n)
-
 blobkey :: L8.ByteString -> Maybe Key
 blobkey bs = do
     let (pre,bs1) = L8.splitAt 7 bs
-- 
cgit v1.2.3