Browse Source

modified the API not to allow custom certificate directories; wrote some haddock documentation to defer crl, ocsp, basicconstraints for the time-being

master
Jon Kristensen 15 years ago
parent
commit
0dda2728af
  1. 32
      Network/XMPP/Session.hs
  2. 4
      Network/XMPP/Types.hs

32
Network/XMPP/Session.hs

@ -221,7 +221,7 @@ defaultState c t h s i = State { stateClientHandlers = h @@ -221,7 +221,7 @@ defaultState c t h s i = State { stateClientHandlers = h
-- details on how they operate.
connect :: MonadIO m => Session s m -> HostName -> PortNumber ->
Maybe (Maybe ([X509], Bool), ([X509] -> Bool), Maybe [String]) ->
Maybe (Maybe [X509], ([X509] -> Bool)) ->
Maybe (UserName, Password, Maybe Resource) ->
(ConnectResult -> StateT s m ()) -> StateT s m ()
@ -229,8 +229,8 @@ connect s h p t a c = openStreams s h p connect' @@ -229,8 +229,8 @@ connect s h p t a c = openStreams s h p connect'
where
connect' r = case r of
OpenStreamSuccess _ _ -> case t of -- TODO: Check for TLS support?
Just (certificate, certificateValidator, paths) ->
tlsSecureStreams s certificate certificateValidator paths connect''
Just (certificate, certificateValidator) ->
tlsSecureStreams s certificate certificateValidator connect''
Nothing -> connect'' (SecureWithTLSSuccess 1.0 "") -- TODO
OpenStreamFailure -> c ConnectOpenStreamFailure
connect'' r = case r of
@ -257,25 +257,29 @@ openStreams s h p c = CMS.get >>= @@ -257,25 +257,29 @@ openStreams s h p c = CMS.get >>=
-- Tries to secure the connection with TLS.
--
-- If the list of certificates is provided, they will be presented to the
-- server; the boolean value controls whether the client will show its
-- certificates before the server has authed.
-- server.
--
-- The third parameter is an optional custom validation function for the server
-- certificates. Note that Pontarius XMPP will perform its own validation
-- according to the RFC 6120, including comparing the domain name specified in
-- the certificate against the connected server, as well as checking the
-- integrity, the certificate authority, and CRL and\/or OCSP repositories of
-- the certificate chain. The fourth parameter is a list of directories that
-- contains trusted certificate authorities.
-- integrity, and the certificate authorities.
--
-- Note: The current implementation of `certificate' looks for trusted
-- certificates in the /etc/ssl/certs directory.
--
-- Note: The current implementation of `certificate' does not support parsing
-- X509 extensions. Because of this, we will defer checking CRLs and/or OCSP
-- services as well as checking for the basicConstraints cA boolean for the
-- time-being.
tlsSecureStreams :: MonadIO m => Session s m -> Maybe ([X509], Bool) ->
([X509] -> Bool) -> Maybe [String] ->
(SecureWithTLSResult -> StateT s m ()) -> StateT s m ()
tlsSecureStreams :: MonadIO m => Session s m -> Maybe [X509] ->
([X509] -> Bool) -> (SecureWithTLSResult -> StateT s m ()) -> StateT s m ()
tlsSecureStreams s c a p c_ = CMS.get >>=
tlsSecureStreams s c a c_ = CMS.get >>=
(\ state -> lift $ liftIO $
writeChan (sessionChannel s)
(IEC (CESecureWithTLS c a p c_)))
(IEC (CESecureWithTLS c a c_)))
-- |
@ -439,7 +443,7 @@ processEvent e = get >>= \ state -> @@ -439,7 +443,7 @@ processEvent e = get >>= \ state ->
put $ state { stateShouldExit = True }
return $ Just e
IEC (CESecureWithTLS certificate verifyCertificate paths callback) -> do
IEC (CESecureWithTLS certificate verifyCertificate callback) -> do
-- CEB.assert (not $ isTLSSecured (stateStreamState state)) (return ())
let Connected _ handle = stateConnectionState state
lift $ liftIO $ send "<starttls xmlns='urn:ietf:params:xml:ns:xmpp-tls'/>" (Left handle)

4
Network/XMPP/Types.hs

@ -393,7 +393,7 @@ data AuthenticationState = NoAuthentication | AuthenticatingPreChallenge1 String @@ -393,7 +393,7 @@ data AuthenticationState = NoAuthentication | AuthenticatingPreChallenge1 String
data ClientEvent s m = CEOpenStream N.HostName PortNumber
(OpenStreamResult -> StateT s m ()) |
CESecureWithTLS (Maybe ([X509], Bool)) ([X509] -> Bool) (Maybe [String])
CESecureWithTLS (Maybe [X509]) ([X509] -> Bool)
(SecureWithTLSResult -> StateT s m ()) |
CEAuthenticate UserName Password (Maybe Resource)
(AuthenticateResult -> StateT s m ()) |
@ -404,7 +404,7 @@ data ClientEvent s m = CEOpenStream N.HostName PortNumber @@ -404,7 +404,7 @@ data ClientEvent s m = CEOpenStream N.HostName PortNumber
instance Show (ClientEvent s m) where
show (CEOpenStream h p _) = "CEOpenStream " ++ h ++ " " ++ (show p)
show (CESecureWithTLS c _ _ _) = "CESecureWithTLS " ++ (show c)
show (CESecureWithTLS c _ _) = "CESecureWithTLS " ++ (show c)
show (CEAuthenticate u p r _) = "CEAuthenticate " ++ u ++ " " ++ p ++ " " ++
(show r)
show (CEIQ s _ _ _) = "CEIQ"

Loading…
Cancel
Save