Skip to content
Browse files

Version 1.20140713. Update to HsOpenSSL-0.11

  • Loading branch information...
1 parent cd5d1c4 commit 55a465ba12b9a59012e4baa2d662c254aff4a737 @rnons committed Jul 13, 2014
Showing with 14 additions and 122 deletions.
  1. +4 −0 CHANGELOG
  2. +0 −110 Shadowsocks/Cipher.hsc
  3. +4 −4 Shadowsocks/Encrypt.hs
  4. +6 −8 shadowsocks.cabal
View
4 CHANGELOG
@@ -0,0 +1,4 @@
+CHANGELOG
+
+1.20140617 -> 1.20140713
+ - Update to HsOpenSSL-0.11
View
110 Shadowsocks/Cipher.hsc
@@ -1,110 +0,0 @@
--- Shamelessly taken from https://github.com/phonohawk/HsOpenSSL
--- With ByteString version of cipherInit
-
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE CPP #-}
-{-# LANGUAGE ForeignFunctionInterface #-}
-
-module Shadowsocks.Cipher
- ( CryptoMode (..)
- , cipherInit
- , cipherUpdateBS
- , getCipherByName
- ) where
-
-#include <openssl/evp.h>
-
-import Control.Applicative ((<$>))
-import Control.Exception (mask_)
-import Control.Monad (void)
-import qualified Data.ByteString.Internal as B8
-import Data.ByteString (useAsCStringLen)
-import Foreign.C
-import Foreign.C.Types
-import Foreign.ForeignPtr
-import Foreign.Marshal.Alloc (alloca)
-import Foreign.Ptr
-import Foreign.Storable (Storable(..))
-
-foreign import ccall unsafe "EVP_CIPHER_CTX_init"
- _cipher_ctx_init :: Ptr EVP_CIPHER_CTX -> IO ()
-
-foreign import ccall unsafe "&EVP_CIPHER_CTX_cleanup"
- _cipher_ctx_cleanup :: FunPtr (Ptr EVP_CIPHER_CTX -> IO ())
-
-foreign import ccall unsafe "EVP_CIPHER_CTX_block_size"
- _cipher_ctx_block_size :: Ptr EVP_CIPHER_CTX -> CInt
-
-foreign import ccall unsafe "EVP_get_cipherbyname"
- _get_cipherbyname :: CString -> IO (Ptr EVP_CIPHER)
-
-foreign import ccall unsafe "EVP_CipherInit"
- _CipherInit :: Ptr EVP_CIPHER_CTX
- -> Ptr EVP_CIPHER -> CString -> CString -> CInt -> IO CInt
-
-foreign import ccall unsafe "EVP_CipherUpdate"
- _CipherUpdate :: Ptr EVP_CIPHER_CTX -> Ptr CChar -> Ptr CInt
- -> Ptr CChar -> CInt -> IO CInt
-
-newtype Cipher = Cipher (Ptr EVP_CIPHER)
-data EVP_CIPHER
-
-newtype CipherCtx = CipherCtx (ForeignPtr EVP_CIPHER_CTX)
-data EVP_CIPHER_CTX
-
-newCipherCtx :: IO CipherCtx
-newCipherCtx = do
- ctx <- mallocForeignPtrBytes (#size EVP_CIPHER_CTX)
- mask_ $ do
- withForeignPtr ctx _cipher_ctx_init
- addForeignPtrFinalizer _cipher_ctx_cleanup ctx
- return $ CipherCtx ctx
-
-withCipherCtxPtr :: CipherCtx -> (Ptr EVP_CIPHER_CTX -> IO a) -> IO a
-withCipherCtxPtr (CipherCtx ctx) = withForeignPtr ctx
-
--- |@'getCipherByName' name@ returns a symmetric cipher algorithm
--- whose name is @name@. If no algorithms are found, the result is
--- @Nothing@.
-getCipherByName :: String -> IO (Maybe Cipher)
-getCipherByName name
- = withCString name $ \ namePtr ->
- do ptr <- _get_cipherbyname namePtr
- return $ if ptr == nullPtr then Nothing else Just $ Cipher ptr
-
-data CryptoMode = Encrypt | Decrypt
-
-cryptoModeToInt :: CryptoMode -> CInt
-cryptoModeToInt Encrypt = 1
-cryptoModeToInt Decrypt = 0
-
-cipherInit :: Cipher
- -> B8.ByteString -> B8.ByteString -> CryptoMode -> IO CipherCtx
-cipherInit (Cipher c) key iv mode
- = do ctx <- newCipherCtx
- withCipherCtxPtr ctx $ \ ctxPtr ->
- useAsCStringLen key $ \ (keyPtr, _) ->
- useAsCStringLen iv $ \ (ivPtr, _) ->
- _CipherInit ctxPtr c keyPtr ivPtr (cryptoModeToInt mode)
- >>= failIf_ (/= 1)
- return ctx
-
-cipherUpdateBS :: CipherCtx -> B8.ByteString -> IO B8.ByteString
-cipherUpdateBS ctx inBS =
- withCipherCtxPtr ctx $ \ctxPtr ->
- useAsCStringLen inBS $ \(inBuf, inLen) ->
- let len = inLen + fromIntegral (_cipher_ctx_block_size ctxPtr) - 1 in
- B8.createAndTrim len $ \outBuf ->
- alloca $ \outLenPtr ->
- _CipherUpdate ctxPtr (castPtr outBuf) outLenPtr inBuf
- (fromIntegral inLen)
- >>= failIf (/= 1)
- >> fromIntegral <$> peek outLenPtr
-
-failIf :: (a -> Bool) -> a -> IO a
-failIf f a
- | f a = error "error"
- | otherwise = return a
-
-failIf_ :: (a -> Bool) -> a -> IO ()
-failIf_ f a = void $ failIf f a
View
8 Shadowsocks/Encrypt.hs
@@ -19,10 +19,10 @@ import Data.Maybe (fromJust)
import Data.Monoid ((<>))
import Data.Word (Word8, Word64)
import OpenSSL (withOpenSSL)
+import OpenSSL.EVP.Cipher (getCipherByName, CryptoMode(..))
+import OpenSSL.EVP.Internal (cipherInitBS, cipherUpdateBS)
import OpenSSL.Random (randBytes)
-import Shadowsocks.Cipher
-
method_supported :: HM.HashMap String (Int, Int)
method_supported = HM.fromList
@@ -85,7 +85,7 @@ getSSLEncDec method password = do
decipherCtx <- newEmptyMVar
cipherMethod <- fmap fromJust $ withOpenSSL $ getCipherByName method
- ctx <- cipherInit cipherMethod key cipher_iv Encrypt
+ ctx <- cipherInitBS cipherMethod key cipher_iv Encrypt
let
encrypt "" = return ""
encrypt buf = do
@@ -102,7 +102,7 @@ getSSLEncDec method password = do
if empty
then do
let decipher_iv = S.take m1 buf
- dctx <- cipherInit cipherMethod key decipher_iv Decrypt
+ dctx <- cipherInitBS cipherMethod key decipher_iv Decrypt
putMVar decipherCtx dctx
if S.null (S.drop m1 buf)
then return ""
View
14 shadowsocks.cabal
@@ -1,5 +1,5 @@
name: shadowsocks
-version: 1.20140617
+version: 1.20140713
synopsis: A fast tunnel proxy that help you get through firewalls
description:
Shadowsocks implemented in Haskell. Original python version: <https://github.com/clowwindy/shadowsocks>
@@ -22,8 +22,7 @@ source-repository head
executable sslocal
main-is: local.hs
ghc-options: -Wall -fno-warn-unused-do-bind -O2 -threaded
- other-modules: Shadowsocks.Cipher,
- Shadowsocks.Encrypt,
+ other-modules: Shadowsocks.Encrypt,
Shadowsocks.Util
other-extensions: OverloadedStrings, DeriveGeneric
build-depends: base == 4.*,
@@ -32,7 +31,7 @@ executable sslocal
bytestring >= 0.9,
containers >= 0.5,
cryptohash >= 0.11,
- HsOpenSSL >= 0.10,
+ HsOpenSSL >= 0.11,
network >= 2.4,
optparse-applicative >= 0.8,
unordered-containers >= 0.2
@@ -41,8 +40,7 @@ executable sslocal
executable ssserver
main-is: server.hs
ghc-options: -Wall -fno-warn-unused-do-bind -O2 -threaded
- other-modules: Shadowsocks.Cipher,
- Shadowsocks.Encrypt,
+ other-modules: Shadowsocks.Encrypt,
Shadowsocks.Util
other-extensions: OverloadedStrings, DeriveGeneric
build-depends: base == 4.*,
@@ -51,7 +49,7 @@ executable ssserver
bytestring >= 0.9,
containers >= 0.5,
cryptohash >= 0.11,
- HsOpenSSL >= 0.10,
+ HsOpenSSL >= 0.11,
network >= 2.4,
optparse-applicative >= 0.8,
unordered-containers >= 0.2
@@ -67,7 +65,7 @@ test-suite test
bytestring >= 0.9,
containers >= 0.5,
cryptohash >= 0.11,
- HsOpenSSL >= 0.10,
+ HsOpenSSL >= 0.11,
network >= 2.4,
optparse-applicative >= 0.8,
process >= 1.1,

0 comments on commit 55a465b

Please sign in to comment.
Something went wrong with that request. Please try again.