openssh-protocol (empty) → 0.0.1

raw patch · 9 files changed

+351/−0 lines, 9 filesdep +basedep +bytestringdep +cerealsetup-changed

Dependencies added: base, bytestring, cereal, hedgehog, integer-logarithms, openssh-protocol, text, time, vector

Files

ChangeLog.md +5/−0
LICENSE +30/−0
README.md +29/−0
Setup.hs +2/−0
openssh-protocol.cabal +54/−0
src/Crypto/OpenSSH/Protocol/Decode.hs +59/−0
src/Crypto/OpenSSH/Protocol/Encode.hs +88/−0
test/Test/Crypto/OpenSSH/Protocol.hs +67/−0
test/test.hs +17/−0

+ ChangeLog.md view

@@ -0,0 +1,5 @@+# Revision history for openssh-protocol++## 0.0.1  -- 2019-01-27++* First version. Extracted from internal libraries.

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c) 2019, HotelKilo++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Mark Hibberd nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,29 @@+# openssh-protocol++Haskell implementation of openssh protocol primitives.++The openssh primitives are defined in [RFC4251](https://www.ietf.org/rfc/rfc4251.txt).++They are used by various parts of the openssh toolchain:+ - [ssh](https://github.com/openssh/openssh-portable/blob/master/PROTOCOL)+ - [certificates](https://github.com/openssh/openssh-portable/blob/master/PROTOCOL.certkey)+ - [agent](https://github.com/openssh/openssh-portable/blob/master/PROTOCOL.agent)+ - [certkeys](https://github.com/openssh/openssh-portable/blob/master/PROTOCOL.certkeys)+ - [key](https://github.com/openssh/openssh-portable/blob/master/PROTOCOL.key)+ - [krl](https://github.com/openssh/openssh-portable/blob/master/PROTOCOL.krl)+ - [mux](https://github.com/openssh/openssh-portable/blob/master/PROTOCOL.mux)++### Stability++This library should be considered stable. Primitives will+be added but will not removed.++### Future++Right now, these are the building blocks required to implement the+higher level protocol components. They are useful, but the end goal+is to produce public implementations of all the protocol,+most importantly:+ - Key pair encode/decode.+ - Ceritificate encode/decode + signing.+ - Agent message protocol.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ openssh-protocol.cabal view

@@ -0,0 +1,54 @@+name: openssh-protocol+version: 0.0.1+synopsis: Haskell implementation of openssh protocol primitives.+homepage: https://github.com/smith-security/openssh-protocol+license:  BSD3+license-file: LICENSE+author: Mark Hibberd+maintainer: mth@smith.st+copyright: (c) 2019, HotelKilo+bug-reports: https://github.com/smith-security/openssh-protocol/issues+category: Security+build-type: Simple+extra-source-files: ChangeLog.md, README.md+cabal-version: >= 1.10+description:+  This is a library collecting openssh protocol primitives+  using 'cereal'.+source-repository head+  type:     git+  location: git@github.com:smith-security/openssh-protocol.git++library+  default-language: Haskell2010+  build-depends:+      base >= 4.10 && < 5+    , bytestring == 0.10.*+    , cereal == 0.5.*+    , integer-logarithms == 1.*+    , text == 1.*+    , time == 1.*+    , vector == 0.12.*++  hs-source-dirs:+    src++  exposed-modules:+    Crypto.OpenSSH.Protocol.Encode+    Crypto.OpenSSH.Protocol.Decode+++test-suite test+  default-language: Haskell2010+  type: exitcode-stdio-1.0+  main-is: test.hs+  hs-source-dirs: test+  build-depends:+      base >= 4.10 && < 5+    , cereal+    , hedgehog == 0.6.*+    , openssh-protocol+    , time++  other-modules:+    Test.Crypto.OpenSSH.Protocol

+ src/Crypto/OpenSSH/Protocol/Decode.hs view

@@ -0,0 +1,59 @@+-- |+-- OpenSSH protocol primitives as defined by <RFC4251 https://www.ietf.org/rfc/rfc4251.txt>.+--+{-# LANGUAGE ScopedTypeVariables #-}+module Crypto.OpenSSH.Protocol.Decode (+    text+  , string+  , uint32+  , uint64+  , mpint+  , time+  , utc+  ) where++import           Data.Bits (Bits (..))+import           Data.ByteString (ByteString)+import qualified Data.Serialize as Serialize+import           Data.Text (Text)+import qualified Data.Text.Encoding as Text+import           Data.Time (UTCTime)+import           Data.Time.Clock.POSIX (POSIXTime)+import qualified Data.Time.Clock.POSIX as Time+import           Data.Word (Word32, Word64)+import qualified Data.Vector.Primitive as Vector+++text :: Serialize.Get Text+text =+  Text.decodeUtf8 <$> string++string :: Serialize.Get ByteString+string =+  uint32 >>= Serialize.getBytes . fromIntegral++uint32 :: Serialize.Get Word32+uint32 =+  Serialize.getWord32be++uint64 :: Serialize.Get Word64+uint64 =+  Serialize.getWord64be++mpint :: Serialize.Get Integer+mpint = do+  size <- fromIntegral <$> uint32+  bytes <- Vector.replicateM size Serialize.getWord8+  let+    value = Vector.foldl' (\acc el -> (acc `shiftL` 8) + fromIntegral el) (0 :: Integer) bytes+    negative = size > 0 && testBit (Vector.head bytes) 7+  pure $+    if negative then value - 2 ^ (size * 8) else value++time :: Serialize.Get POSIXTime+time =+  fromIntegral <$> uint64++utc :: Serialize.Get UTCTime+utc =+  Time.posixSecondsToUTCTime <$> time

+ src/Crypto/OpenSSH/Protocol/Encode.hs view

@@ -0,0 +1,88 @@+-- |+-- OpenSSH protocol primitives as defined by <RFC4251 https://www.ietf.org/rfc/rfc4251.txt>.+--+module Crypto.OpenSSH.Protocol.Encode (+    text+  , string+  , uint32+  , uint64+  , mpint+  , time+  , utc+  ) where++import           Data.Bits (Bits (..))+import           Data.ByteString (ByteString)+import qualified Data.ByteString as ByteString+import qualified Data.Serialize as Serialize+import           Data.Text (Text)+import qualified Data.Text.Encoding as Text+import           Data.Time (UTCTime)+import           Data.Time.Clock.POSIX (POSIXTime)+import qualified Data.Time.Clock.POSIX as Time+import           Data.Word (Word8, Word32, Word64)+import qualified Data.Vector.Primitive as Vector++import qualified Math.NumberTheory.Logarithms as Logarithms+++text :: Text -> Serialize.Put+text =+  string . Text.encodeUtf8++string :: ByteString -> Serialize.Put+string bytes = do+  uint32 . fromIntegral . ByteString.length $ bytes+  Serialize.putByteString bytes++uint32 :: Word32 -> Serialize.Put+uint32 =+  Serialize.putWord32be++uint64 :: Word64 -> Serialize.Put+uint64 =+  Serialize.putWord64be++mpint :: Integer -> Serialize.Put+mpint n =+  string . Serialize.runPut $+    Vector.forM_ (expand n) $+      Serialize.put++time :: POSIXTime -> Serialize.Put+time =+  uint64 . floor . toRational++utc :: UTCTime -> Serialize.Put+utc =+  uint64 . floor . toRational . Time.utcTimeToPOSIXSeconds++expand :: Integer -> Vector.Vector Word8+expand n =+  let+    base = expand' n+  in+    if n == 0 then+      Vector.empty+    else if n > 0 && testBit (Vector.head base) 7 then+      Vector.cons 0 base+    else if n < 0 && not (testBit (Vector.head base) 7) then+      Vector.cons 0xff base+    else+      base++expand' :: Integer -> Vector.Vector Word8+expand' nn =+  let+    loop x n =+      let+        (n', w) = quotRem n 256+      in+        if n == 0 then x else loop (fromIntegral w : x) n'+    bytes =+      (Logarithms.integerLogBase 2 (abs nn) + 1) `quot` 8 + 1+  in+    if nn < 0 then+      expand' $ 2 ^ (8 * bytes) + nn+    else+      Vector.fromList . loop [] $ nn

+ test/Test/Crypto/OpenSSH/Protocol.hs view

@@ -0,0 +1,67 @@+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE OverloadedStrings #-}+module Test.Crypto.OpenSSH.Protocol where++import qualified Crypto.OpenSSH.Protocol.Encode as Encode+import qualified Crypto.OpenSSH.Protocol.Decode as Decode++import qualified Data.Serialize as Serialize+import qualified Data.Time as Time++import           Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+++trip :: (Eq a, Show a) => (a -> Serialize.Put) -> Serialize.Get a -> Gen a -> PropertyT IO ()+trip put get gen = do+  a <- forAll gen+  Right a === Serialize.runGet get (Serialize.runPut $ put a)++prop_mpint :: Property+prop_mpint =+  withTests 10000 . property $ do+    trip Encode.mpint Decode.mpint $+      Gen.integral (Range.linearFrom 0 (-999999999999999999999999) 999999999999999999999999)++prop_text :: Property+prop_text =+  withTests 10000 . property $ do+    trip Encode.text Decode.text $+      Gen.text (Range.linear 0 100) Gen.alphaNum++prop_string :: Property+prop_string =+  withTests 10000 . property $ do+    trip Encode.string Decode.string $+      Gen.utf8 (Range.linear 0 100) Gen.alphaNum++prop_uint32 :: Property+prop_uint32 =+  withTests 10000 . property $ do+    trip Encode.uint32 Decode.uint32 $+      Gen.integral Range.linearBounded++prop_uint64 :: Property+prop_uint64 =+  withTests 10000 . property $ do+    trip Encode.uint64 Decode.uint64 $+      Gen.integral Range.linearBounded++prop_time :: Property+prop_time =+  withTests 10000 . property $ do+    trip Encode.time Decode.time $+      fromIntegral <$> Gen.int (Range.linear 0 maxBound)++prop_utc :: Property+prop_utc =+  withTests 10000 . property $ do+    trip Encode.utc Decode.utc $ do+      day <- Time.ModifiedJulianDay <$> Gen.integral (Range.linearFrom 50000 58500 90000)+      time <- fromInteger <$> Gen.integral (Range.constant 0 86399)+      pure $ Time.UTCTime day time++tests :: IO Bool+tests =+  checkParallel $$(discover)

+ test/test.hs view

@@ -0,0 +1,17 @@+{-# LANGUAGE NoImplicitPrelude #-}++import           Control.Monad ((>>=), (>>), when, mapM)++import           Prelude (($), (.), not, all, id)++import qualified System.Exit as Exit+import           System.IO (IO)+import qualified System.IO as IO++import qualified Test.Crypto.OpenSSH.Protocol++main :: IO ()+main =+  IO.hSetBuffering IO.stdout IO.LineBuffering >> mapM id [+      Test.Crypto.OpenSSH.Protocol.tests+    ] >>= \rs -> when (not . all id $ rs) Exit.exitFailure