slrnsc
commented
10 years ago ghc 7.9 seems to fix this.
Closed slrnsc closed 10 years ago
slrnsc
commented
10 years ago ghc 7.9 seems to fix this.
benmos
commented
9 years ago For anyone wanting to quickly glance at the Haskell code contained above, it's:
module Main where
import Network
import Network.Socket
import Control.Monad
import Control.Concurrent
import Network.TLS
import Network.TLS.Extra
import Crypto.Random
import Data.X509
import Data.X509.File
import Data.Default.Class
myForkIO = forkIO
--myForkIO = forkOS
--myForkIO = id
main :: IO ()
main = do
let base = "debugmin"
let keys = Keys (base ++ ".crt") (base ++ "-plaintext.key") (base ++ ".combined.crt")
withSocketsDo $ do
listenClientsTLS keys
forever $ threadDelay 100000000
listenClientsTLS :: Keys -> IO ()
listenClientsTLS keys = do
let port = 12342
sock <- socket AF_INET6 Stream defaultProtocol
setSocketOption sock ReuseAddr 1
bind sock (SockAddrInet6 port 0 iN6ADDR_ANY 0)
listen sock 1
putStrLn "listening"
myForkIO $ forever $ acceptClientTLS keys sock; return ()
acceptClientTLS :: Keys -> Socket -> IO ()
acceptClientTLS keys socket = do
(h,host,_) <- Network.accept socket
pool <- createEntropyPool
creds <- credentialLoadX509 (keysCert $ keys) (keysPrivKey $ keys)
x509 <- readSignedObject $ keysCert $ keys
privKey <- readKeyFile $ keysPrivKey $ keys
clientCert <- (fmap (!!0) $ readSignedObject $ keysClientCert $ keys) :: IO (SignedExact Certificate)
let creds' = case creds of
Left err -> error $ "reading private key: "++err
Right ok -> ok
let tlsParams = ServerParams
{ serverWantClientCert = True
, serverHooks = (def :: ServerHooks)
, serverCACertificates = x509
, serverDHEParams = Nothing
, serverShared = (def :: Shared)
{ sharedCredentials = Credentials [creds'] }
, serverSupported = (def :: Supported)
{ supportedVersions = [TLS12]
, supportedCiphers = ciphersuite_strong
}
}
tlsContext <- contextNew h tlsParams (cprgCreate pool :: SystemRNG)
myForkIO (do putStrLn "before"; handshake tlsContext; putStrLn "after")
return ()
data Keys = Keys
{ keysCert :: FilePath
, keysPrivKey :: FilePath
, keysClientCert :: FilePath
}
The base64-encoded tar.gz below (github does not seem to allow attachments) is a fairly minimal testcase for a segfault. Run with
./run.shand provide the same password three times before hitting enter for the rest of the key-generation setup. It will open an xterm to show the output of the OpenSSL client. Notably, I cannot produce a crash using the equivalent GnuTLS command (gnutls-cli --no-ca-verification --x509certfile debugmin.crt --x509keyfile debugmin-plaintext.key 127.0.0.1 -p 12342).The crash is intermittent and may take 5-20 seconds (1-4 tries) to occur. Sometimes the runtime aborts and other times the program segfaults. The backtrace from the abort looks like:
debug.tar.gz: