diff --git a/crypto-pubkey-openssh.cabal b/crypto-pubkey-openssh.cabal --- a/crypto-pubkey-openssh.cabal +++ b/crypto-pubkey-openssh.cabal @@ -1,5 +1,5 @@ Name: crypto-pubkey-openssh -Version: 0.1.0 +Version: 0.2.0 Synopsis: OpenSSH public keys parser Description: OpenSSH public keys parser License: MIT @@ -7,6 +7,7 @@ Copyright: Fedor Gogolev Author: Fedor Gogolev Maxim Mitroshin + Thomas DuBuisson Maintainer: Fedor Gogolev Homepage: https://github.com/knsd/crypto-pubkey-openssh Bug-reports: https://github.com/knsd/crypto-pubkey-openssh/issues @@ -24,12 +25,14 @@ Hs-source-dirs: src Ghc-options: -Wall -fno-warn-orphans Default-language: Haskell2010 - Build-depends: base == 4.6.* || == 4.5.* - , bytestring == 0.10.* || == 0.9.* - , base64-bytestring == 1.0.* - , cereal == 0.3.* - , attoparsec == 0.10.* - , crypto-pubkey-types == 0.2.* + Build-depends: base == 4.6.* || == 4.5.* + , bytestring == 0.10.* || == 0.9.* + , base64-bytestring == 1.0.* + , cereal == 0.3.* + , attoparsec == 0.10.* + , crypto-pubkey-types == 0.3.* + , pem == 0.1.* + , asn1-data == 0.7.* Exposed-modules: Crypto.PubKey.OpenSsh Other-modules: Crypto.PubKey.OpenSsh.Types @@ -50,7 +53,9 @@ , base64-bytestring == 1.0.* , cereal == 0.3.* , attoparsec == 0.10.* - , crypto-pubkey-types == 0.2.* + , crypto-pubkey-types == 0.3.* + , pem == 0.1.* + , asn1-data == 0.7.* , test-framework == 0.8.* , test-framework-quickcheck2 == 0.3.* diff --git a/src/Crypto/PubKey/OpenSsh.hs b/src/Crypto/PubKey/OpenSsh.hs --- a/src/Crypto/PubKey/OpenSsh.hs +++ b/src/Crypto/PubKey/OpenSsh.hs @@ -1,9 +1,12 @@ module Crypto.PubKey.OpenSsh ( OpenSshPublicKey(..) - , encode - , decode + , OpenSshPrivateKey(..) + , encodePublic + , decodePublic + , encodePrivate + , decodePrivate ) where -import Crypto.PubKey.OpenSsh.Types (OpenSshPublicKey(..)) -import Crypto.PubKey.OpenSsh.Encode (encode) -import Crypto.PubKey.OpenSsh.Decode (decode) +import Crypto.PubKey.OpenSsh.Types (OpenSshPublicKey(..), OpenSshPrivateKey(..)) +import Crypto.PubKey.OpenSsh.Encode (encodePublic, encodePrivate) +import Crypto.PubKey.OpenSsh.Decode (decodePublic, decodePrivate) diff --git a/src/Crypto/PubKey/OpenSsh/Decode.hs b/src/Crypto/PubKey/OpenSsh/Decode.hs --- a/src/Crypto/PubKey/OpenSsh/Decode.hs +++ b/src/Crypto/PubKey/OpenSsh/Decode.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} module Crypto.PubKey.OpenSsh.Decode where @@ -11,20 +11,24 @@ import Data.Attoparsec.ByteString.Char8 (Parser, parseOnly, take, space, isSpace, takeTill) +import Data.PEM (PEM(..), pemParseBS) +import Data.ASN1.Encoding (decodeASN1') +import Data.ASN1.Stream (ASN1(IntVal, Start, End), ASN1ConstructionType(Sequence)) +import Data.ASN1.BinaryEncoding (DER(..)) import Data.Serialize (Get, getBytes, runGet, getWord32be, getWord8) import qualified Data.ByteString.Base64 as Base64 import qualified Crypto.Types.PubKey.DSA as DSA import qualified Crypto.Types.PubKey.RSA as RSA -import Crypto.PubKey.OpenSsh.Types (OpenSshPublicKeyType(..), - OpenSshPublicKey(..)) +import Crypto.PubKey.OpenSsh.Types (OpenSshKeyType(..), OpenSshPublicKey(..), + OpenSshPrivateKey(..)) typeSize :: Int typeSize = 7 -readType :: Monad m => ByteString -> m OpenSshPublicKeyType -readType "ssh-rsa" = return OpenSshPublicKeyTypeRsa -readType "ssh-dss" = return OpenSshPublicKeyTypeDsa +readType :: Monad m => ByteString -> m OpenSshKeyType +readType "ssh-rsa" = return OpenSshKeyTypeRsa +readType "ssh-dss" = return OpenSshKeyTypeDsa readType _ = fail "Invalid key type" calculateSize :: Integer -> Int @@ -44,10 +48,10 @@ getOpenSshPublicKey = do size <- fmap fromIntegral $ getWord32be getBytes size >>= readType >>= \typ -> case typ of - OpenSshPublicKeyTypeRsa -> parseRsa - OpenSshPublicKeyTypeDsa -> parseDsa + OpenSshKeyTypeRsa -> parseRsa + OpenSshKeyTypeDsa -> parseDsa where - parseRsa = do + parseRsa = do e <- getInteger n <- getInteger return $ OpenSshPublicKeyRsa $ RSA.PublicKey (calculateSize n) n e @@ -56,7 +60,7 @@ q <- getInteger g <- getInteger y <- getInteger - return $ OpenSshPublicKeyDsa $ DSA.PublicKey (p, g, q) y + return $ OpenSshPublicKeyDsa $ DSA.PublicKey (DSA.Params p g q) y openSshPublicKeyParser :: Parser OpenSshPublicKey openSshPublicKeyParser = do @@ -70,5 +74,51 @@ commentParser = void space *> (takeTill $ \c -> isSpace c || isControl c) <|> return "" -decode :: ByteString -> Either String OpenSshPublicKey -decode = parseOnly openSshPublicKeyParser +decodePublic :: ByteString -> Either String OpenSshPublicKey +decodePublic = parseOnly openSshPublicKeyParser + +decodePrivate :: ByteString -> Either String OpenSshPrivateKey +decodePrivate bs = pemParseBS bs >>= \pems -> case pems of + [] -> Left "Private key not found" + (_:_:_) -> Left "Too many private keys" + [p@(PEM { .. })] -> do + case pemName of + "RSA PRIVATE KEY" -> parseRSA p + "DSA PRIVATE KEY" -> parseDSA p + _ -> Left "Unknown private key type" + where + parseDSA :: PEM -> Either String OpenSshPrivateKey + parseDSA (PEM {..}) = + case decodeASN1' DER pemContent of + Left er -> Left (show er) + Right [ Start Sequence + , IntVal _version + , IntVal params_p + , IntVal params_q + , IntVal params_g + , IntVal public_y + , IntVal private_x + , End Sequence + ] -> let private_params = DSA.Params {..} + in Right (OpenSshPrivateKeyDsa ( DSA.PrivateKey {..} )public_y) + Right _ -> Left "Invalid ASN1 stream found in PEM." + + parseRSA :: PEM -> Either String OpenSshPrivateKey + parseRSA (PEM {..}) = + case decodeASN1' DER pemContent of + Left er -> Left (show er) + Right [ Start Sequence + , IntVal _version + , IntVal public_n + , IntVal public_e + , IntVal private_d + , IntVal private_p + , IntVal private_q + , IntVal private_dP + , IntVal private_dQ + , IntVal private_qinv + , End Sequence + ] -> let public_size = calculateSize public_n + private_pub = RSA.PublicKey { .. } + in Right (OpenSshPrivateKeyRsa (RSA.PrivateKey {..})) + Right _ -> Left "Invalid ASN1 stream found in PEM." diff --git a/src/Crypto/PubKey/OpenSsh/Encode.hs b/src/Crypto/PubKey/OpenSsh/Encode.hs --- a/src/Crypto/PubKey/OpenSsh/Encode.hs +++ b/src/Crypto/PubKey/OpenSsh/Encode.hs @@ -1,4 +1,4 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, RecordWildCards #-} module Crypto.PubKey.OpenSsh.Encode where @@ -10,12 +10,16 @@ import qualified Data.ByteString as BS import Data.Serialize (Put, Putter, runPut, putByteString, putWord32be, put) +import Data.ASN1.Encoding (encodeASN1') +import Data.ASN1.Stream (ASN1(IntVal, Start, End), ASN1ConstructionType(Sequence)) +import Data.ASN1.BinaryEncoding (DER(..)) +import Data.PEM (PEM(..), pemWriteBS) import qualified Crypto.Types.PubKey.DSA as DSA import qualified Crypto.Types.PubKey.RSA as RSA import qualified Data.ByteString.Base64 as Base64 -import Crypto.PubKey.OpenSsh.Types (OpenSshPublicKeyType(..), - OpenSshPublicKey(..)) +import Crypto.PubKey.OpenSsh.Types (OpenSshKeyType(..), OpenSshPublicKey(..), + OpenSshPrivateKey(..)) fixZeroByte :: [Word8] -> [Word8] fixZeroByte bs = if testBit (head bs) msb then 0:bs else bs @@ -31,9 +35,9 @@ getResults :: (Integer, Integer) -> (Word8, Integer) getResults (i, w) = (fromIntegral w, i) -keyTypePutter :: Putter OpenSshPublicKeyType -keyTypePutter OpenSshPublicKeyTypeRsa = putByteString "ssh-rsa" -keyTypePutter OpenSshPublicKeyTypeDsa = putByteString "ssh-dss" +keyTypePutter :: Putter OpenSshKeyType +keyTypePutter OpenSshKeyTypeRsa = putByteString "ssh-rsa" +keyTypePutter OpenSshKeyTypeDsa = putByteString "ssh-dss" mpint :: Integer -> ByteString mpint i = runPut $ do @@ -42,7 +46,7 @@ where binary = fixZeroByte $ expandInteger i -commonPublicKeyPutter :: OpenSshPublicKeyType +commonPublicKeyPutter :: OpenSshKeyType -> ByteString -> ByteString -> Put @@ -59,22 +63,62 @@ putWord32be $ fromIntegral $ BS.length $ binaryType putByteString binaryType +commonPrivateKeyPutter :: OpenSshKeyType + -> ByteString + -> Put +commonPrivateKeyPutter OpenSshKeyTypeRsa body = do + putByteString $ pemWriteBS $ PEM "RSA PRIVATE KEY" [] body +commonPrivateKeyPutter OpenSshKeyTypeDsa body = do + putByteString $ pemWriteBS $ PEM "DSA PRIVATE KEY" [] body + openSshPublicKeyPutter :: Putter OpenSshPublicKey openSshPublicKeyPutter (OpenSshPublicKeyRsa (RSA.PublicKey _ public_n public_e) comment) = - commonPublicKeyPutter OpenSshPublicKeyTypeRsa comment $ BS.concat + commonPublicKeyPutter OpenSshKeyTypeRsa comment $ BS.concat [ mpint public_e , mpint public_n ] openSshPublicKeyPutter (OpenSshPublicKeyDsa - (DSA.PublicKey (public_p, public_g, public_q) public_y) + (DSA.PublicKey (DSA.Params public_p public_g public_q) public_y) comment) = - commonPublicKeyPutter OpenSshPublicKeyTypeDsa comment $ BS.concat + commonPublicKeyPutter OpenSshKeyTypeDsa comment $ BS.concat [ mpint public_p , mpint public_q , mpint public_g , mpint public_y ] -encode :: OpenSshPublicKey -> ByteString -encode = runPut . openSshPublicKeyPutter +openSshPrivateKeyPutter :: Putter OpenSshPrivateKey +openSshPrivateKeyPutter (OpenSshPrivateKeyRsa (RSA.PrivateKey {..})) = + let RSA.PublicKey{..} = private_pub + in commonPrivateKeyPutter OpenSshKeyTypeRsa $ encodeASN1' DER + [ Start Sequence + , IntVal 0 -- version + , IntVal public_n + , IntVal public_e + , IntVal private_d + , IntVal private_p + , IntVal private_q + , IntVal private_dP + , IntVal private_dQ + , IntVal private_qinv + , End Sequence + ] +openSshPrivateKeyPutter (OpenSshPrivateKeyDsa (DSA.PrivateKey {..}) public_y) = + let DSA.Params{..} = private_params + in commonPrivateKeyPutter OpenSshKeyTypeDsa $ encodeASN1' DER + [ Start Sequence + , IntVal 0 -- version + , IntVal params_p + , IntVal params_q + , IntVal params_g + , IntVal public_y + , IntVal private_x + , End Sequence + ] + +encodePublic :: OpenSshPublicKey -> ByteString +encodePublic = runPut . openSshPublicKeyPutter + +encodePrivate :: OpenSshPrivateKey -> ByteString +encodePrivate k = runPut $ openSshPrivateKeyPutter k diff --git a/src/Crypto/PubKey/OpenSsh/Types.hs b/src/Crypto/PubKey/OpenSsh/Types.hs --- a/src/Crypto/PubKey/OpenSsh/Types.hs +++ b/src/Crypto/PubKey/OpenSsh/Types.hs @@ -5,10 +5,14 @@ import qualified Crypto.Types.PubKey.DSA as DSA import qualified Crypto.Types.PubKey.RSA as RSA +data OpenSshPrivateKey = OpenSshPrivateKeyRsa RSA.PrivateKey + | OpenSshPrivateKeyDsa DSA.PrivateKey DSA.PublicNumber + deriving (Eq, Show) + data OpenSshPublicKey = OpenSshPublicKeyRsa RSA.PublicKey ByteString | OpenSshPublicKeyDsa DSA.PublicKey ByteString deriving (Eq, Show) -data OpenSshPublicKeyType = OpenSshPublicKeyTypeRsa - | OpenSshPublicKeyTypeDsa +data OpenSshKeyType = OpenSshKeyTypeRsa + | OpenSshKeyTypeDsa deriving (Eq, Show) diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-} +{-# LANGUAGE TypeSynonymInstances #-} module Main where @@ -6,55 +7,69 @@ import System.FilePath.Posix ((), (<.>)) import System.Process (runCommand, waitForProcess) import System.IO.Temp (withSystemTempDirectory) -import qualified Data.ByteString as SB +import qualified Data.ByteString.Char8 as SB import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) -import Test.QuickCheck (Property, Arbitrary(..), elements) +import Test.QuickCheck (Property, Arbitrary(..), elements, suchThat) import Test.QuickCheck.Monadic (monadicIO, run, assert) -import Crypto.PubKey.OpenSsh.Types (OpenSshPublicKeyType(..), - OpenSshPublicKey(..)) -import Crypto.PubKey.OpenSsh.Encode (encode) -import Crypto.PubKey.OpenSsh.Decode (decode) +import Crypto.PubKey.OpenSsh.Types (OpenSshKeyType(..), OpenSshPublicKey(..), + OpenSshPrivateKey(..)) +import Crypto.PubKey.OpenSsh (encodePublic, decodePublic, + encodePrivate, decodePrivate) type StrictByteString = SB.ByteString +type PrivateKey = StrictByteString +type PublicKey = StrictByteString -instance Arbitrary OpenSshPublicKeyType where - arbitrary = elements [OpenSshPublicKeyTypeRsa, OpenSshPublicKeyTypeDsa] +instance Arbitrary OpenSshKeyType where + arbitrary = elements [OpenSshKeyTypeRsa, OpenSshKeyTypeDsa] -openSshPubKey :: OpenSshPublicKeyType -> IO StrictByteString -openSshPubKey t = withSystemTempDirectory base $ \dir -> do +openSshKeys :: OpenSshKeyType -> IO (PrivateKey, PublicKey) +openSshKeys t = withSystemTempDirectory base $ \dir -> do let path = dir typ let run = "ssh-keygen -t " <> typ <> " -N \"\" -f " <> path waitForProcess =<< runCommand run - fmap SB.init $ SB.readFile $ path <.> "pub" + priv <- SB.readFile $ path + pub <- fmap SB.init $ SB.readFile $ path <.> "pub" + return (priv, pub) where base = "crypto-pubkey-openssh-tests" typ = case t of - OpenSshPublicKeyTypeRsa -> "rsa" - OpenSshPublicKeyTypeDsa -> "dsa" + OpenSshKeyTypeRsa -> "rsa" + OpenSshKeyTypeDsa -> "dsa" -testWithOpenSsh :: OpenSshPublicKeyType -> Property +testWithOpenSsh :: OpenSshKeyType -> Property testWithOpenSsh t = monadicIO $ do - pub <- run $ openSshPubKey t - assert $ check (decode pub) pub + (priv, pub) <- run $ openSshKeys t + assert $ checkPublic (decodePublic pub) pub + assert $ checkPrivate (decodePrivate priv) priv where - check = case t of - OpenSshPublicKeyTypeRsa -> \r b -> case r of + checkPublic = case t of + OpenSshKeyTypeRsa -> \r b -> case r of Right k@(OpenSshPublicKeyRsa _ _) -> - encode k == b + encodePublic k == b _ -> False - OpenSshPublicKeyTypeDsa -> \r b -> case r of + OpenSshKeyTypeDsa -> \r b -> case r of Right k@(OpenSshPublicKeyDsa _ _) -> - encode k == b + encodePublic k == b _ -> False + checkPrivate = case t of + OpenSshKeyTypeRsa -> \r b -> case r of + Right k@(OpenSshPrivateKeyRsa _) -> + encodePrivate k == b + _ -> False + OpenSshKeyTypeDsa -> \r b -> case r of + Right k@(OpenSshPrivateKeyDsa _ _) -> + encodePrivate k == b + _ -> False main :: IO () main = defaultMain [ #ifdef OPENSSH - testGroup "ssh-keygen" [ testProperty "decode" $ testWithOpenSsh + testGroup "ssh-keygen" [ testProperty "decode/encode" $ testWithOpenSsh ] #endif ]