2016-05-20 3 views
1

Я создал программу с использованием http-conduit и ей нужно поговорить с сервером, у которого нет действительного сертификата TLS. В этом случае это самозаверяющий сертификат.Как вы получаете http-conduit для принятия самоподписанных сертификатов?

по протоколу HTTPS test.hs:

#!/usr/bin/env stack 
-- stack --install-ghc --resolver lts-5.13 runghc --package http-conduit 
{-# LANGUAGE OverloadedStrings #-} 
import qualified Data.ByteString.Char8 as S8 
import qualified Data.ByteString.Lazy.Char8 as L8 
import   Network.HTTP.Client 
import   Network.HTTP.Simple 
import   Network.Connection 
       (TLSSettings(..)) 

main :: IO() 
main = do 
    authenticate "self-signed.badssl.com" "" "" 

authenticate :: S8.ByteString 
      -> L8.ByteString 
      -> L8.ByteString 
      -> IO() 
authenticate hostname username password = do 
    let request 
     = setRequestMethod "GET" 
     $ setRequestSecure True 
     $ setRequestPort 443 
     $ setRequestHost hostname 
     $ setRequestPath "/" 
     $ defaultRequest 
    response <- httpLBS request 
    putStrLn $ "The status code was: " ++ 
      show (getResponseStatusCode response) 
    print $ getResponseHeader "Content-Type" response 
    L8.putStrLn $ getResponseBody response 

Ожидаемый выход

The status code was: 200 
["text/html"] 
<!DOCTYPE html> 
<html> 
<head> 
    <meta name="viewport" content="width=device-width, initial-scale=1"> 
    <link rel="shortcut icon" href="/icons/favicon-red.ico"/> 
    <link rel="apple-touch-icon" href="/icons/icon-red.png"/> 
    <title>self-signed.badssl.com</title> 
    <link rel="stylesheet" href="/style.css"> 
    <style>body { background: red; }</style> 
</head> 
<body> 
<div id="content"> 
    <h1 style="font-size: 12vw;"> 
    self-signed.<br>badssl.com 
    </h1> 
</div> 

</body> 
</html> 

Фактический выход:

https-test.hs: TlsExceptionHostPort (HandshakeFailed (Error_Protocol ("certificate rejected: [SelfSigned]",True,CertificateUnknown))) "self-signed.badssl.com" 443 

ответ

2

Это очень плохая идея по многим причинам. Вы намного лучше фиксируете сервер (если можете) или поощряете людей, которые его запускают, чтобы исправить это.

В обход проверки сертификата TLS удаляются все полезные аспекты TLS, поскольку он делает тривиальным для злоумышленника в положении «человек в середине», чтобы претендовать на роль сервера и манипулировать данными. Все злоумышленники должны сделать это, повторно зашифровать перехваченный, обработанный контент другим другим плохим самозаверяющим сертификатом. Ваше клиентское программное обеспечение не будет более разумным.

http-conduit поддерживает концепцию менеджера запросов. Используя диспетчер запросов, вы можете предоставить альтернативный файл.

Сначала вы можете построить TLSSettingsSimple, который отключает проверку сертификата сервера (TLSSettingsSimple is defined in Network.Connection in the connection package):

noVerifyTlsSettings :: TLSSettings 
noVerifyTlsSettings = TLSSettingsSimple 
    { settingDisableCertificateValidation = True 
    , settingDisableSession = True 
    , settingUseServerName = False 
    } 

Затем вы можете сделать менеджер запроса, который использует эту (mkManagerSettings comes from the Network.HTTP.Client.TLS module in the http-client-tls package):

noVerifyTlsManagerSettings :: ManagerSettings 
noVerifyTlsManagerSettings = mkManagerSettings noVerifyTlsSettings Nothing 

Тогда вы можете инициализируйте этот диспетчер запросов и установите его на запрос:

manager <- newManager noVerifyTlsManagerSettings 
-- ... 
$ setRequestManager manager 
-- ... 

Вам также необходимо иметь HTTP-клиент-TLS пакета доступную для этого, так что вы должны изменить аргументы для стека включить это:

--package http-client-tls 

Вот полное решение:

#!/usr/bin/env stack 
-- stack --install-ghc --resolver lts-5.13 runghc --package http-client-tls 
{-# LANGUAGE OverloadedStrings #-} 
import qualified Data.ByteString.Char8 as S8 
import qualified Data.ByteString.Lazy.Char8 as L8 
import   Network.HTTP.Client 
import   Network.HTTP.Client.TLS (mkManagerSettings) 
import   Network.HTTP.Simple 
import   Network.Connection (TLSSettings(..)) 

main :: IO() 
main = do 
    authenticate "self-signed.badssl.com" "" "" 

authenticate :: S8.ByteString 
      -> L8.ByteString 
      -> L8.ByteString 
      -> IO() 
authenticate hostname username password = do 
    manager <- newManager noVerifyTlsManagerSettings 
    let request 
     = setRequestMethod "GET" 
     $ setRequestSecure True 
     $ setRequestPort 443 
     $ setRequestHost hostname 
     $ setRequestPath "/" 
     $ setRequestManager manager 
     $ defaultRequest 
    response <- httpLBS request 
    putStrLn $ "The status code was: " ++ 
      show (getResponseStatusCode response) 
    print $ getResponseHeader "Content-Type" response 
    L8.putStrLn $ getResponseBody response 

noVerifyTlsManagerSettings :: ManagerSettings 
noVerifyTlsManagerSettings = mkManagerSettings noVerifyTlsSettings Nothing 

noVerifyTlsSettings :: TLSSettings 
noVerifyTlsSettings = TLSSettingsSimple 
    { settingDisableCertificateValidation = True 
    , settingDisableSession = True 
    , settingUseServerName = False 
    }