diff --git a/crypto-pubkey-openssh.cabal b/crypto-pubkey-openssh.cabal --- a/crypto-pubkey-openssh.cabal +++ b/crypto-pubkey-openssh.cabal @@ -1,11 +1,12 @@ Name: crypto-pubkey-openssh -Version: 0.0.0 +Version: 0.1.0 Synopsis: OpenSSH public keys parser Description: OpenSSH public keys parser License: MIT License-file: LICENSE Copyright: Fedor Gogolev Author: Fedor Gogolev + Maxim Mitroshin Maintainer: Fedor Gogolev Homepage: https://github.com/knsd/crypto-pubkey-openssh Bug-reports: https://github.com/knsd/crypto-pubkey-openssh/issues @@ -15,18 +16,48 @@ Cabal-version: >= 1.12 Tested-with: GHC == 7.6.* +Flag OpenSsh + Description: Test with openssh-keygen + Default: False + Library Hs-source-dirs: src Ghc-options: -Wall -fno-warn-orphans Default-language: Haskell2010 - Build-depends: base == 4.6.* - , bytestring == 0.10.* + 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.* Exposed-modules: Crypto.PubKey.OpenSsh + Other-modules: Crypto.PubKey.OpenSsh.Types + Crypto.PubKey.OpenSsh.Encode + Crypto.PubKey.OpenSsh.Decode + +Test-suite crypto-pubkey-openssh-tests + Main-is: Tests.hs + Hs-source-dirs: src, tests + Default-language: Haskell2010 + Type: exitcode-stdio-1.0 + + if flag(OpenSsh) + cpp-options: -DOPENSSH + + 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.* + + , test-framework == 0.8.* + , test-framework-quickcheck2 == 0.3.* + , QuickCheck == 2.5.* + , temporary == 1.1.* + , process == 1.1.* + , filepath == 1.3.* Source-repository head Type: git 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,77 +1,9 @@ -{-# LANGUAGE OverloadedStrings #-} - module Crypto.PubKey.OpenSsh ( OpenSshPublicKey(..) - , openSshPublicKeyParser - , parseOpenSshPublicKey + , encode + , decode ) where -import Prelude hiding (take) - -import Control.Monad (void, replicateM) -import Data.ByteString.Char8 (ByteString) - -import Data.Attoparsec.ByteString.Char8 (Parser, parseOnly, take, space, - isSpace, takeTill) -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 - -data OpenSshPublicKey = OpenSshPublicKeyRsa RSA.PublicKey - | OpenSshPublicKeyDsa DSA.PublicKey - deriving (Eq, Show) - -data OpenSshPublicKeyType = OpenSshPublicKeyTypeRsa - | OpenSshPublicKeyTypeDsa - deriving (Eq, Show) - -typeSize :: Int -typeSize = 7 - -readType :: Monad m => ByteString -> m OpenSshPublicKeyType -readType "ssh-rsa" = return OpenSshPublicKeyTypeRsa -readType "ssh-dss" = return OpenSshPublicKeyTypeDsa -readType _ = fail "Invalid key type" - -calculateSize :: Integer -> Int -calculateSize = go 1 - where - go i n | 2 ^ (i * 8) > n = i - | otherwise = go (i + 1) n - -getInteger :: Get Integer -getInteger = do - size <- fmap fromIntegral getWord32be - ints <- fmap reverse $ replicateM size $ fmap toInteger getWord8 - return $ fst $ flip foldl1 (zip ints ([0..] :: [Integer])) $ - \(a, _) (c, p) -> (c * (256 ^ p) + a, p) - -getOpenSshPublicKey :: Get OpenSshPublicKey -getOpenSshPublicKey = do - size <- fmap fromIntegral $ getWord32be - getBytes size >>= readType >>= \typ -> case typ of - OpenSshPublicKeyTypeRsa -> parseRsa - OpenSshPublicKeyTypeDsa -> parseDsa - where - parseRsa = do - e <- getInteger - n <- getInteger - return $ OpenSshPublicKeyRsa $ RSA.PublicKey (calculateSize n) n e - parseDsa = do - p <- getInteger - q <- getInteger - g <- getInteger - y <- getInteger - return $ OpenSshPublicKeyDsa $ DSA.PublicKey (p, g, q) y - -openSshPublicKeyParser :: Parser OpenSshPublicKey -openSshPublicKeyParser = do - _typ <- readType =<< take typeSize - void space - b64 <- takeTill isSpace - binary <- either fail return $ Base64.decode b64 - either fail return $ runGet getOpenSshPublicKey binary - -parseOpenSshPublicKey :: ByteString -> Either String OpenSshPublicKey -parseOpenSshPublicKey = parseOnly openSshPublicKeyParser +import Crypto.PubKey.OpenSsh.Types (OpenSshPublicKey(..)) +import Crypto.PubKey.OpenSsh.Encode (encode) +import Crypto.PubKey.OpenSsh.Decode (decode) diff --git a/src/Crypto/PubKey/OpenSsh/Decode.hs b/src/Crypto/PubKey/OpenSsh/Decode.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/PubKey/OpenSsh/Decode.hs @@ -0,0 +1,74 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Crypto.PubKey.OpenSsh.Decode where + +import Prelude hiding (take) + +import Control.Applicative ((*>), (<|>)) +import Control.Monad (void, replicateM) +import Data.ByteString.Char8 (ByteString) +import Data.Char (isControl) + +import Data.Attoparsec.ByteString.Char8 (Parser, parseOnly, take, space, + isSpace, takeTill) +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(..)) + +typeSize :: Int +typeSize = 7 + +readType :: Monad m => ByteString -> m OpenSshPublicKeyType +readType "ssh-rsa" = return OpenSshPublicKeyTypeRsa +readType "ssh-dss" = return OpenSshPublicKeyTypeDsa +readType _ = fail "Invalid key type" + +calculateSize :: Integer -> Int +calculateSize = go 1 + where + go i n | 2 ^ (i * 8) > n = i + | otherwise = go (i + 1) n + +getInteger :: Get Integer +getInteger = do + size <- fmap fromIntegral getWord32be + ints <- fmap reverse $ replicateM size $ fmap toInteger getWord8 + return $ fst $ flip foldl1 (zip ints ([0..] :: [Integer])) $ + \(a, _) (c, p) -> (c * (256 ^ p) + a, p) + +getOpenSshPublicKey :: Get (ByteString -> OpenSshPublicKey) +getOpenSshPublicKey = do + size <- fmap fromIntegral $ getWord32be + getBytes size >>= readType >>= \typ -> case typ of + OpenSshPublicKeyTypeRsa -> parseRsa + OpenSshPublicKeyTypeDsa -> parseDsa + where + parseRsa = do + e <- getInteger + n <- getInteger + return $ OpenSshPublicKeyRsa $ RSA.PublicKey (calculateSize n) n e + parseDsa = do + p <- getInteger + q <- getInteger + g <- getInteger + y <- getInteger + return $ OpenSshPublicKeyDsa $ DSA.PublicKey (p, g, q) y + +openSshPublicKeyParser :: Parser OpenSshPublicKey +openSshPublicKeyParser = do + void $ readType =<< take typeSize + void space + b64 <- takeTill isSpace + binary <- either fail return $ Base64.decode b64 + partialKey <- either fail return $ runGet getOpenSshPublicKey binary + fmap partialKey commentParser + where + commentParser = void space *> (takeTill $ \c -> isSpace c || isControl c) + <|> return "" + +decode :: ByteString -> Either String OpenSshPublicKey +decode = parseOnly openSshPublicKeyParser diff --git a/src/Crypto/PubKey/OpenSsh/Encode.hs b/src/Crypto/PubKey/OpenSsh/Encode.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/PubKey/OpenSsh/Encode.hs @@ -0,0 +1,80 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Crypto.PubKey.OpenSsh.Encode where + +import Control.Monad (when) +import Data.ByteString.Char8 (ByteString) +import Data.Bits (testBit) +import Data.List (unfoldr) +import Data.Word (Word8) +import qualified Data.ByteString as BS + +import Data.Serialize (Put, Putter, runPut, putByteString, putWord32be, put) +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(..)) + +fixZeroByte :: [Word8] -> [Word8] +fixZeroByte bs = if testBit (head bs) msb then 0:bs else bs + where + msb = 7 + +expandInteger :: Integer -> [Word8] +expandInteger n = reverse $ unfoldr expand $ n + where + expand :: Integer -> Maybe (Word8, Integer) + expand e | e == 0 = Nothing + | otherwise = Just $ getResults $ quotRem e 256 + getResults :: (Integer, Integer) -> (Word8, Integer) + getResults (i, w) = (fromIntegral w, i) + +keyTypePutter :: Putter OpenSshPublicKeyType +keyTypePutter OpenSshPublicKeyTypeRsa = putByteString "ssh-rsa" +keyTypePutter OpenSshPublicKeyTypeDsa = putByteString "ssh-dss" + +mpint :: Integer -> ByteString +mpint i = runPut $ do + putWord32be $ fromIntegral $ length binary + mapM_ put binary + where + binary = fixZeroByte $ expandInteger i + +commonPublicKeyPutter :: OpenSshPublicKeyType + -> ByteString + -> ByteString + -> Put +commonPublicKeyPutter keyType comment body = do + keyTypePutter keyType + putByteString " " + putByteString $ Base64.encode $ BS.append wrapType body + when (not $ BS.null comment) $ do + putByteString " " + putByteString comment + where + binaryType = runPut $ keyTypePutter keyType + wrapType = runPut $ do + putWord32be $ fromIntegral $ BS.length $ binaryType + putByteString binaryType + +openSshPublicKeyPutter :: Putter OpenSshPublicKey +openSshPublicKeyPutter (OpenSshPublicKeyRsa + (RSA.PublicKey _ public_n public_e) + comment) = + commonPublicKeyPutter OpenSshPublicKeyTypeRsa comment $ BS.concat + [ mpint public_e + , mpint public_n ] + +openSshPublicKeyPutter (OpenSshPublicKeyDsa + (DSA.PublicKey (public_p, public_g, public_q) public_y) + comment) = + commonPublicKeyPutter OpenSshPublicKeyTypeDsa comment $ BS.concat + [ mpint public_p + , mpint public_q + , mpint public_g + , mpint public_y ] + +encode :: OpenSshPublicKey -> ByteString +encode = runPut . openSshPublicKeyPutter diff --git a/src/Crypto/PubKey/OpenSsh/Types.hs b/src/Crypto/PubKey/OpenSsh/Types.hs new file mode 100644 --- /dev/null +++ b/src/Crypto/PubKey/OpenSsh/Types.hs @@ -0,0 +1,14 @@ +module Crypto.PubKey.OpenSsh.Types where + +import Data.ByteString (ByteString) + +import qualified Crypto.Types.PubKey.DSA as DSA +import qualified Crypto.Types.PubKey.RSA as RSA + +data OpenSshPublicKey = OpenSshPublicKeyRsa RSA.PublicKey ByteString + | OpenSshPublicKeyDsa DSA.PublicKey ByteString + deriving (Eq, Show) + +data OpenSshPublicKeyType = OpenSshPublicKeyTypeRsa + | OpenSshPublicKeyTypeDsa + deriving (Eq, Show) diff --git a/tests/Tests.hs b/tests/Tests.hs new file mode 100644 --- /dev/null +++ b/tests/Tests.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE CPP #-} + +module Main where + +import Data.Monoid ((<>)) +import System.FilePath.Posix ((), (<.>)) +import System.Process (runCommand, waitForProcess) +import System.IO.Temp (withSystemTempDirectory) +import qualified Data.ByteString as SB + +import Test.Framework (Test, defaultMain, testGroup) +import Test.Framework.Providers.QuickCheck2 (testProperty) +import Test.QuickCheck (Property, Arbitrary(..), elements) +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) + +type StrictByteString = SB.ByteString + +instance Arbitrary OpenSshPublicKeyType where + arbitrary = elements [OpenSshPublicKeyTypeRsa, OpenSshPublicKeyTypeDsa] + +openSshPubKey :: OpenSshPublicKeyType -> IO StrictByteString +openSshPubKey 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" + where + base = "crypto-pubkey-openssh-tests" + typ = case t of + OpenSshPublicKeyTypeRsa -> "rsa" + OpenSshPublicKeyTypeDsa -> "dsa" + +testWithOpenSsh :: OpenSshPublicKeyType -> Property +testWithOpenSsh t = monadicIO $ do + pub <- run $ openSshPubKey t + assert $ check (decode pub) pub + where + check = case t of + OpenSshPublicKeyTypeRsa -> \r b -> case r of + Right k@(OpenSshPublicKeyRsa _ _) -> + encode k == b + _ -> False + OpenSshPublicKeyTypeDsa -> \r b -> case r of + Right k@(OpenSshPublicKeyDsa _ _) -> + encode k == b + _ -> False + +main :: IO () +main = defaultMain + [ +#ifdef OPENSSH + testGroup "ssh-keygen" [ testProperty "decode" $ testWithOpenSsh + ] +#endif + ]