Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse code

Changes from 0.8.0.2 to 0.9

Ignore-this: 1fdc5b440aaa21b3da9a0fb356c04eb
---------------------------
* (Suggested by Arthur Chan) Operations in OpenSSL.Session now throw
  exceptions of individual exception types instead of plain
  strings. The following exception types are defined:

    - ConnectionCleanlyClosed
    - ConnectionAbruptlyTerminated
    - WantConnect
    - WantAccept
    - WantX509Lookup
    - SSLIOError
    - ProtocolError
    - UnknownError(..)

darcs-hash:20101113102353-62b54-e5213e4e7106ad486a23970342256631b6cf1c65.gz
  • Loading branch information...
commit 923bf74f000a5f94a8def8f7cb5c533dc91ba174 1 parent 25b38ab
PHO phonohawk authored

Showing 3 changed files with 160 additions and 16 deletions. Show diff stats Hide diff stats

  1. +1 1  HsOpenSSL.cabal
  2. +16 0 NEWS
  3. +143 15 OpenSSL/Session.hsc
2  HsOpenSSL.cabal
@@ -5,7 +5,7 @@ Description:
5 5 can generate RSA and DSA keys, read and write PEM files,
6 6 generate message digests, sign and verify messages, encrypt
7 7 and decrypt messages.
8   -Version: 0.8.0.2
  8 +Version: 0.9
9 9 License: PublicDomain
10 10 License-File: COPYING
11 11 Author: Adam Langley <agl at imperialviolet dot org>,
16 NEWS
... ... @@ -1,5 +1,21 @@
1 1 -*- coding: utf-8 -*-
2 2
  3 +Changes from 0.8.0.2 to 0.9
  4 +---------------------------
  5 +* (Suggested by Arthur Chan) Operations in OpenSSL.Session now throw
  6 + exceptions of individual exception types instead of plain
  7 + strings. The following exception types are defined:
  8 +
  9 + - ConnectionCleanlyClosed
  10 + - ConnectionAbruptlyTerminated
  11 + - WantConnect
  12 + - WantAccept
  13 + - WantX509Lookup
  14 + - SSLIOError
  15 + - ProtocolError
  16 + - UnknownError(..)
  17 +
  18 +
3 19 Changes from 0.8 to 0.8.0.2
4 20 ---------------------------
5 21 * 0.8.0.1 was broken so it's invalidated.
158 OpenSSL/Session.hsc
@@ -33,15 +33,27 @@ module OpenSSL.Session
33 33 , getPeerCertificate
34 34 , getVerifyResult
35 35 , sslSocket
  36 +
  37 + -- * SSL Exceptions
  38 + , SomeSSLException
  39 + , ConnectionCleanlyClosed
  40 + , ConnectionAbruptlyTerminated
  41 + , WantConnect
  42 + , WantAccept
  43 + , WantX509Lookup
  44 + , SSLIOError
  45 + , ProtocolError
  46 + , UnknownError(..)
36 47 ) where
37 48
38 49 #include "openssl/ssl.h"
39 50
40   -import Prelude hiding (read, ioError)
  51 +import Prelude hiding (catch, read, ioError)
41 52 import Control.Concurrent (threadWaitWrite, threadWaitRead)
42 53 import Control.Concurrent.QSem
43   -import Control.Exception (finally)
  54 +import Control.Exception
44 55 import Control.Monad
  56 +import Data.Typeable
45 57 import Foreign
46 58 import Foreign.C
47 59 import qualified Data.ByteString as B
@@ -49,7 +61,7 @@ import qualified Data.ByteString.Internal as B
49 61 import qualified Data.ByteString.Unsafe as B
50 62 import qualified Data.ByteString.Lazy as L
51 63 import qualified Data.ByteString.Lazy.Internal as L
52   -import System.IO.Error (mkIOError, ioError, eofErrorType, isEOFError)
  64 +import System.IO.Error (mkIOError, eofErrorType, isEOFError)
53 65 import System.IO.Unsafe
54 66 import System.Posix.Types (Fd(..))
55 67 import Network.Socket (Socket(..))
@@ -268,15 +280,14 @@ foreign import ccall "SSL_accept" _ssl_accept :: Ptr SSL_ -> IO CInt
268 280 foreign import ccall "SSL_connect" _ssl_connect :: Ptr SSL_ -> IO CInt
269 281 foreign import ccall unsafe "SSL_get_error" _ssl_get_error :: Ptr SSL_ -> CInt -> IO CInt
270 282
271   -sslErrorToString :: CInt -> String
272   -sslErrorToString (#const SSL_ERROR_NONE) = "SSL: No error"
273   -sslErrorToString (#const SSL_ERROR_ZERO_RETURN) = "SSL: connection cleanly closed"
274   -sslErrorToString (#const SSL_ERROR_WANT_CONNECT) = "SSL: want connect"
275   -sslErrorToString (#const SSL_ERROR_WANT_ACCEPT) = "SSL: want accept"
276   -sslErrorToString (#const SSL_ERROR_WANT_X509_LOOKUP) = "SSL: want X509 lookup"
277   -sslErrorToString (#const SSL_ERROR_SYSCALL) = "SSL: syscall error"
278   -sslErrorToString (#const SSL_ERROR_SSL) = "SSL: ssl protocol error"
279   -sslErrorToString x = "SSL: unknown error " ++ show x
  283 +throwSSLException :: CInt -> IO a
  284 +throwSSLException (#const SSL_ERROR_ZERO_RETURN ) = throw ConnectionCleanlyClosed
  285 +throwSSLException (#const SSL_ERROR_WANT_CONNECT ) = throw WantConnect
  286 +throwSSLException (#const SSL_ERROR_WANT_ACCEPT ) = throw WantAccept
  287 +throwSSLException (#const SSL_ERROR_WANT_X509_LOOKUP) = throw WantX509Lookup
  288 +throwSSLException (#const SSL_ERROR_SYSCALL ) = throw SSLIOError
  289 +throwSSLException (#const SSL_ERROR_SSL ) = throw ProtocolError
  290 +throwSSLException x = throw (UnknownError (fromIntegral x))
280 291
281 292 -- | This is the type of an SSL IO operation. EOF and termination are handled
282 293 -- by exceptions while everything else is one of these. Note that reading
@@ -301,7 +312,7 @@ sslDoHandshake action ssl@(SSL (_, _, fd, _)) = do
301 312 case err of
302 313 (#const SSL_ERROR_WANT_READ) -> return WantRead
303 314 (#const SSL_ERROR_WANT_WRITE) -> return WantWrite
304   - _ -> fail $ sslErrorToString err
  315 + _ -> throwSSLException err
305 316 result <- withSSL ssl f
306 317 case result of
307 318 Done n -> return n
@@ -340,14 +351,14 @@ sslIOInner f ptr nbytes ssl = do
340 351 | n == 0 -> do
341 352 shutdown <- _ssl_get_shutdown ssl
342 353 if shutdown .&. (#const SSL_RECEIVED_SHUTDOWN) == 0
343   - then fail "SSL connection abruptly terminated"
  354 + then throw ConnectionAbruptlyTerminated
344 355 else ioError $ mkIOError eofErrorType "" Nothing Nothing
345 356 _ -> do
346 357 err <- _ssl_get_error ssl n
347 358 case err of
348 359 (#const SSL_ERROR_WANT_READ) -> return WantRead
349 360 (#const SSL_ERROR_WANT_WRITE) -> return WantWrite
350   - _ -> fail $ sslErrorToString err
  361 + _ -> throwSSLException err
351 362
352 363 -- | Try the read the given number of bytes from an SSL connection. On EOF an
353 364 -- empty ByteString is returned. If the connection dies without a graceful
@@ -457,3 +468,120 @@ getVerifyResult ssl =
457 468 -- | Get the socket underlying an SSL connection
458 469 sslSocket :: SSL -> Socket
459 470 sslSocket (SSL (_, _, _, socket)) = socket
  471 +
  472 +
  473 +-- | The root exception type for all SSL exceptions.
  474 +data SomeSSLException
  475 + = forall e. Exception e => SomeSSLException e
  476 + deriving Typeable
  477 +
  478 +instance Show SomeSSLException where
  479 + show (SomeSSLException e) = show e
  480 +
  481 +instance Exception SomeSSLException
  482 +
  483 +sslExceptionToException :: Exception e => e -> SomeException
  484 +sslExceptionToException = toException . SomeSSLException
  485 +
  486 +sslExceptionFromException :: Exception e => SomeException -> Maybe e
  487 +sslExceptionFromException x
  488 + = do SomeSSLException a <- fromException x
  489 + cast a
  490 +
  491 +-- | The TLS\/SSL connection has been closed. If the protocol version
  492 +-- is SSL 3.0 or TLS 1.0, this result code is returned only if a
  493 +-- closure alert has occurred in the protocol, i.e. if the connection
  494 +-- has been closed cleanly. Note that in this case
  495 +-- 'ConnectionCleanlyClosed' does not necessarily indicate that the
  496 +-- underlying transport has been closed.
  497 +data ConnectionCleanlyClosed
  498 + = ConnectionCleanlyClosed
  499 + deriving (Typeable, Show, Eq)
  500 +
  501 +instance Exception ConnectionCleanlyClosed where
  502 + toException = sslExceptionToException
  503 + fromException = sslExceptionFromException
  504 +
  505 +-- | The peer uncleanly terminated the connection without sending the
  506 +-- \"close notify\" alert.
  507 +data ConnectionAbruptlyTerminated
  508 + = ConnectionAbruptlyTerminated
  509 + deriving (Typeable, Show, Eq)
  510 +
  511 +instance Exception ConnectionAbruptlyTerminated where
  512 + toException = sslExceptionToException
  513 + fromException = sslExceptionFromException
  514 +
  515 +-- | The operation did not complete; the same TLS\/SSL I\/O function
  516 +-- should be called again later. The underlying socket was not
  517 +-- connected yet to the peer and the call would block in
  518 +-- 'connect'. The SSL function should be called again when the
  519 +-- connection is established. This message can only appear with
  520 +-- 'connect'.
  521 +data WantConnect
  522 + = WantConnect
  523 + deriving (Typeable, Show, Eq)
  524 +
  525 +instance Exception WantConnect where
  526 + toException = sslExceptionToException
  527 + fromException = sslExceptionFromException
  528 +
  529 +-- | The operation did not complete; the same TLS\/SSL I\/O function
  530 +-- should be called again later. The underlying socket was not
  531 +-- connected yet to the peer and the call would block in 'accept'. The
  532 +-- SSL function should be called again when the connection is
  533 +-- established. This message can only appear with 'accept'.
  534 +data WantAccept
  535 + = WantAccept
  536 + deriving (Typeable, Show, Eq)
  537 +
  538 +instance Exception WantAccept where
  539 + toException = sslExceptionToException
  540 + fromException = sslExceptionFromException
  541 +
  542 +-- | The operation did not complete because an application callback
  543 +-- set by SSL_CTX_set_client_cert_cb() has asked to be called
  544 +-- again. The TLS\/SSL I\/O function should be called again
  545 +-- later. Details depend on the application.
  546 +data WantX509Lookup
  547 + = WantX509Lookup
  548 + deriving (Typeable, Show, Eq)
  549 +
  550 +instance Exception WantX509Lookup where
  551 + toException = sslExceptionToException
  552 + fromException = sslExceptionFromException
  553 +
  554 +-- | Some I\/O error occurred. The OpenSSL error queue may contain
  555 +-- more information on the error. If the error queue is empty
  556 +-- (i.e. ERR_get_error() returns 0), ret can be used to find out more
  557 +-- about the error: If ret == 0, an EOF was observed that violates the
  558 +-- protocol. If ret == -1, the underlying BIO reported an I\/O error
  559 +-- (for socket I\/O on Unix systems, consult errno for details).
  560 +data SSLIOError
  561 + = SSLIOError
  562 + deriving (Typeable, Show, Eq)
  563 +
  564 +instance Exception SSLIOError where
  565 + toException = sslExceptionToException
  566 + fromException = sslExceptionFromException
  567 +
  568 +-- | A failure in the SSL library occurred, usually a protocol
  569 +-- error. The OpenSSL error queue contains more information on the
  570 +-- error.
  571 +data ProtocolError
  572 + = ProtocolError
  573 + deriving (Typeable, Show, Eq)
  574 +
  575 +instance Exception ProtocolError where
  576 + toException = sslExceptionToException
  577 + fromException = sslExceptionFromException
  578 +
  579 +-- | SSL_get_error() returned an error code which is unknown to this
  580 +-- library.
  581 +data UnknownError
  582 + = UnknownError !Int
  583 + deriving (Typeable, Show, Eq)
  584 +
  585 +instance Exception UnknownError where
  586 + toException = sslExceptionToException
  587 + fromException = sslExceptionFromException

0 comments on commit 923bf74

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