ssh 0.2.3 → 0.2.4
raw patch · 5 files changed
+31/−48 lines, 5 filesdep +split
Dependencies added: split
Files
- src/SSH.hs +7/−23
- src/SSH/Channel.hs +13/−15
- src/SSH/Crypto.hs +6/−6
- src/SSH/Util.hs +3/−3
- ssh.cabal +2/−1
src/SSH.hs view
@@ -5,11 +5,11 @@ import Control.Monad (replicateM) import Control.Monad.Trans.State import Data.Digest.Pure.SHA (bytestringDigest, sha1)-import Crypto.Classes (Hash) import Crypto.HMAC import Crypto.Hash.MD5 import Crypto.Hash.SHA1 import Data.List (intercalate)+import Data.List.Split (splitOn) import Network import OpenSSL.BN (randIntegerOneToNMinusOne) import System.IO@@ -29,7 +29,7 @@ version :: String-version = "SSH-2.0-Haskell"+version = "SSH-2.0-DarcsDen" supportedKeyExchanges :: [String] supportedKeyExchanges =@@ -51,20 +51,12 @@ supportedMACs :: [(String, LBS.ByteString -> HMAC)] supportedMACs =- [ ("hmac-sha1", makeHMAC 20)- , ("hmac-md5", makeHMAC 16)+ [ ("hmac-sha1", makeHMAC True)+ , ("hmac-md5", makeHMAC False) ] where- makeHMAC :: Int -> LBS.ByteString -> HMAC- makeHMAC 20 k = HMAC 20 $ \b -> runHmac (doHMAC 20 k b :: SHA1)- makeHMAC 16 k = HMAC 16 $ \b -> runHmac (doHMAC 16 k b :: MD5)- makeHMAC u k = error ("unknown key size: " ++ show (u, k))-- doHMAC :: Hash c d => Int -> LBS.ByteString -> LBS.ByteString -> d- doHMAC s k b = hmac (MacKey (strictLBS (LBS.take (fromIntegral s) k))) b-- runHmac :: Hash c d => d -> LBS.ByteString- runHmac = bsToLBS . S.runPut . S.put+ makeHMAC True k = HMAC 20 $ \b -> bsToLBS . S.runPut $ S.put (hmac (MacKey (strictLBS (LBS.take 20 k))) b :: SHA1)+ makeHMAC False k = HMAC 16 $ \b -> bsToLBS . S.runPut $ S.put (hmac (MacKey (strictLBS (LBS.take 16 k))) b :: MD5) bsToLBS = LBS.fromChunks . (: []) @@ -176,18 +168,10 @@ modify (\s -> s { ssInSeq = ssInSeq s + 1 }) readLoop -wordsBy :: Char -> String -> [String]-wordsBy = wordsBy' ""- where- wordsBy' _ _ "" = []- wordsBy' acc x (c:cs)- | x == c = acc : wordsBy' "" x cs- | otherwise = wordsBy' (acc ++ [c]) x cs- kexInit :: Session () kexInit = do cookie <- net $ readBytes 16- nameLists <- replicateM 10 (net readLBS) >>= return . map (wordsBy ',' . fromLBS)+ nameLists <- replicateM 10 (net readLBS) >>= return . map (splitOn "," . fromLBS) kpf <- net readByte dummy <- net readULong
src/SSH/Channel.hs view
@@ -83,7 +83,7 @@ } newChannel :: ChannelConfig -> (SenderMessage -> IO ()) -> Word32 -> Word32 -> Word32 -> Word32 -> String -> IO (Chan ChannelMessage)-newChannel config cssend us them winSize maxPacket user = do+newChannel config csend us them winSize maxPacket user = do chan <- newChan dump ("new channel", winSize, maxPacket)@@ -100,7 +100,7 @@ { csConfig = config , csID = us , csTheirID = them- , csSend = cssend+ , csSend = csend , csDataReceived = 0 , csMaxPacket = maxPacket , csWindowSize = 32768 * 64@@ -118,36 +118,34 @@ chanid <- gets csID case msg of- Request wr cr ->- gets (ccRequestHandler . csConfig) >>= \f -> f wr cr-- Data d -> do+ Request wr cr -> gets (ccRequestHandler . csConfig) >>= \f -> f wr cr+ Data datum -> do modify $ \cs -> cs { csDataReceived =- csDataReceived cs + fromIntegral (LBS.length d)+ csDataReceived cs + fromIntegral (LBS.length datum) } -- Adjust window size if needed rcvd <- gets csDataReceived maxp <- gets csMaxPacket winSize <- gets csTheirWindowSize- when (rcvd + (maxp * 4) >= winSize && winSize + (maxp * 4) <= 2 ^ (32 :: Integer) - 1) $ do- modify (\cs -> cs { csTheirWindowSize = winSize + (maxp * 4) })+ when (rcvd + (maxp * 4) >= winSize && winSize + (maxp * 4) <= 2^(32 :: Integer) - 1) $ do+ modify $ \cs -> cs { csTheirWindowSize = winSize + (maxp * 4) } sendPacket $ do byte 93 long chanid long (maxp * 4) -- Direct input to process's stdin- csproc <- gets csProcess- case csproc of+ cproc <- gets csProcess+ case cproc of Nothing -> dump ("got unhandled data", chanid) Just (Process _ pin _ _) -> do- dump ("redirecting data", chanid, LBS.length d)- io $ LBS.hPut pin d+ dump ("redirecting data", chanid, LBS.length datum)+ io $ LBS.hPut pin datum io $ hFlush pin EOF -> do- modify (\cs -> cs { csDataReceived = 0 })+ modify $ \cs -> cs { csDataReceived = 0 } -- Close process's stdin to indicate EOF cproc <- gets csProcess@@ -202,7 +200,7 @@ where redirectLoop = do dump "reading..."- l <- io getAvailable+ l <- io $ getAvailable dump ("read data from handle", l) if not (null l)
src/SSH/Crypto.hs view
@@ -69,12 +69,12 @@ fromBlocks = LBS.concat modexp :: Integer -> Integer -> Integer -> Integer-modexp x' e' n' = modexp' x' e' n' 1+modexp = modexp' 1 where- modexp' _ 0 _ y = y- modexp' z e n y- | e `mod` 2 == 1 = modexp' ((z ^ (2 :: Integer)) `mod` n) (e `div` 2) n (y * z `mod` n)- | otherwise = modexp' ((z ^ (2 :: Integer)) `mod` n) (e `div` 2) n y+ modexp' y _ 0 _ = y+ modexp' y z e n+ | e `mod` 2 == 1 = modexp' (y * z `mod` n) ((z ^ (2 :: Integer)) `mod` n) (e `div` 2) n+ | otherwise = modexp' y ((z ^ (2 :: Integer)) `mod` n) (e `div` 2) n blob :: PublicKey -> LBS.ByteString blob (RSAPublicKey e n) = doPacket $ do@@ -118,4 +118,4 @@ ] where digest = strictLBS . bytestringDigest . sha1 $ m-sign x l = error ("cannot sign: " ++ show (x, l))+sign _ _ = error "sign: invalid key pair"
src/SSH/Util.hs view
@@ -14,10 +14,10 @@ strictLBS :: LBS.ByteString -> BS.ByteString strictLBS = BS.concat . LBS.toChunks -powersOf :: Integral a => a -> [a]+powersOf :: Num a => a -> [a] powersOf n = 1 : (map (*n) (powersOf n)) -toBase :: Integral a => a -> a -> [Word8]+toBase :: (Integral a, Num b) => a -> a -> [b] toBase x = map fromIntegral . reverse .@@ -39,5 +39,5 @@ pad ++ z where pad = replicate (l - unPaddedLen) (0x00::Word8)- z = toOctets 256 y+ z = toOctets (256 :: Integer) y unPaddedLen = length z
ssh.cabal view
@@ -1,5 +1,5 @@ name: ssh-version: 0.2.3+version: 0.2.4 synopsis: A pure-Haskell SSH server library. description: This package was split from darcsden into its own project; documentation is@@ -57,4 +57,5 @@ random, SHA, SimpleAES,+ split, transformers