summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Kiki.hs24
-rw-r--r--lib/SSHKey.hs15
2 files changed, 25 insertions, 14 deletions
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
13import Control.Applicative 13import Control.Applicative
14import Control.Exception 14import Control.Exception
15import Control.Monad 15import Control.Monad
16import qualified Crypto.Hash as C
16import Data.ASN1.BinaryEncoding 17import Data.ASN1.BinaryEncoding
17import Data.ASN1.Encoding 18import Data.ASN1.Encoding
18import Data.ASN1.Types 19import Data.ASN1.Types
@@ -37,6 +38,7 @@ import System.Posix.Types (FileMode)
37import System.Posix.IO as Posix (createPipe) 38import System.Posix.IO as Posix (createPipe)
38import System.Posix.User 39import System.Posix.User
39#if defined(VERSION_memory) 40#if defined(VERSION_memory)
41import Data.ByteArray (convert)
40import Data.ByteArray.Encoding 42import Data.ByteArray.Encoding
41import qualified Data.ByteString.Char8 as S8 43import qualified Data.ByteString.Char8 as S8
42#elif defined(VERSION_dataenc) 44#elif defined(VERSION_dataenc)
@@ -582,14 +584,15 @@ writePublicKeyFiles rt fw grip myId = do
582 installIpsecConf fw myId cs 584 installIpsecConf fw myId cs
583 fileWriterCommit fw 585 fileWriterCommit fw
584 586
585sshKeyToHostname :: Packet -> IO Char8.ByteString 587
588sshKeyToHostname :: Applicative m => Packet -> m Char8.ByteString
586sshKeyToHostname sshkey = do 589sshKeyToHostname sshkey = do
587 (_, (sout, _serr)) <- runExternal shellScript (Just $ sshblobFromPacket sshkey) 590 case rsaKeyFromPacket sshkey of
588 return $ Char8.fromChunks [sout] 591 Just (RSAKey (MPI n) (MPI e)) -> do
589 where 592 let blob = SSH.sshrsa e n
590 shellScript = 593 sha1 = C.hashlazy blob :: C.Digest C.SHA1
591 "f=$(mktemp) && cat > \"$f\" && ssh-keygen -r _ -f \"$f\" |" ++ 594 pure $ Char8.fromStrict (convertToBase Base16 sha1) <> ".ssh.cryptonomic.net"
592 " (read _ _ _ _ _ hash _ && echo -n $hash.ssh.cryptonomic.net); r=$?; rm -f \"$f\"; exit $r" 595 Nothing -> pure ""
593 596
594peerConnectionName :: Peer -> Char8.ByteString 597peerConnectionName :: Peer -> Char8.ByteString
595peerConnectionName = coerce . peerAddress 598peerConnectionName = coerce . peerAddress
@@ -653,6 +656,13 @@ show_pem' keyspec wkgrip db keyfmt = do
653warn :: String -> IO () 656warn :: String -> IO ()
654warn str = hPutStrLn stderr str 657warn str = hPutStrLn stderr str
655 658
659show_sshfp :: String -> String -> KeyDB -> IO ()
660show_sshfp keyspec wkgrip db = do
661 let s = parseSpec wkgrip keyspec
662 case selectPublicKey s db of
663 Nothing -> hPutStrLn stderr $ keyspec ++ ": not found"
664 Just k -> Char8.putStrLn =<< sshKeyToHostname k
665
656show_ssh :: String -> String -> KeyDB -> IO () 666show_ssh :: String -> String -> KeyDB -> IO ()
657show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db 667show_ssh keyspec wkgrip db = either warn putStrLn $ show_ssh' keyspec wkgrip db
658 668
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
22 22
23type Key = (Integer,Integer) 23type Key = (Integer,Integer)
24 24
25
26sshrsa :: Integer -> Integer -> L.ByteString
27sshrsa e n = runPut $ do
28 putWord32be 7
29 putByteString "ssh-rsa"
30 put (LengthPrefixedBE e)
31 put (LengthPrefixedBE n)
32
25keyblob :: Key -> L.ByteString 33keyblob :: Key -> L.ByteString
26keyblob (n,e) = "ssh-rsa " <> blob 34keyblob (n,e) = "ssh-rsa " <> blob
27 where 35 where
@@ -32,13 +40,6 @@ keyblob (n,e) = "ssh-rsa " <> blob
32 blob = L8.pack $ Base64.encode (L.unpack bs) 40 blob = L8.pack $ Base64.encode (L.unpack bs)
33#endif 41#endif
34 42
35 sshrsa :: Integer -> Integer -> L.ByteString
36 sshrsa e n = runPut $ do
37 putWord32be 7
38 putByteString "ssh-rsa"
39 put (LengthPrefixedBE e)
40 put (LengthPrefixedBE n)
41
42blobkey :: L8.ByteString -> Maybe Key 43blobkey :: L8.ByteString -> Maybe Key
43blobkey bs = do 44blobkey bs = do
44 let (pre,bs1) = L8.splitAt 7 bs 45 let (pre,bs1) = L8.splitAt 7 bs