Skip to content

Commit

Permalink
Merge pull request #32 from SiriusCourses/issue-31
Browse files Browse the repository at this point in the history
Ignore 502 error on helo - fixes communication with some servers
  • Loading branch information
MangoIV authored Jan 9, 2025
2 parents f269e8a + 8ff8b54 commit 22b782c
Showing 1 changed file with 6 additions and 1 deletion.
7 changes: 6 additions & 1 deletion src/Network/HaskellNet/SMTP/SSL.hs
Original file line number Diff line number Diff line change
Expand Up @@ -52,7 +52,7 @@ connectSTARTTLS hostname cfg = do

hn <- getHostName
bsPut bs $ B.pack ("HELO " ++ hn ++ "\r\n")
getResponse bs >>= failIfNot bs 250
getResponse bs >>= failIfNotEx bs (`elem` [250, 502])
bsPut bs $ B.pack ("EHLO " ++ hn ++ "\r\n")
getResponse bs >>= failIfNot bs 250
bsPut bs $ B.pack "STARTTLS\r\n"
Expand All @@ -73,6 +73,11 @@ failIfNot :: BSStream -> Integer -> (Integer, String) -> IO ()
failIfNot bs code (rc, rs) = when (code /= rc) closeAndFail
where closeAndFail = bsClose bs >> fail ("cannot connect to server: " ++ rs)

-- | Extended version of fail if, can support multiple statuses
failIfNotEx :: BSStream -> (Integer -> Bool) -> (Integer, String) -> IO ()
failIfNotEx bs f (rc, rs) = unless (f rc) closeAndFail
where closeAndFail = bsClose bs >> fail ("cannot connect to server: " ++ rs)

-- This is a bit of a nasty hack. Network.HaskellNet.SMTP.connectStream
-- expects to receive a status 220 from the server as soon as it connects,
-- but we've intercepted it in order to establish a STARTTLS connection.
Expand Down

0 comments on commit 22b782c

Please sign in to comment.