e1cb68a0b6
* BUG: Always check for multi-line answers. * BUG: Assume that TLS session is connected after running for one second. * NEW: Print openssl error output if the Debug property is set. git-svn-id: svn://localhost/gambas/trunk@8025 867c0c6c-44f3-4631-809d-bfa615b0a4ec
580 lines
10 KiB
Text
580 lines
10 KiB
Text
' Gambas class file
|
|
|
|
Export
|
|
|
|
Static Private $aDay As String[]
|
|
Static Private $aMonth As String[]
|
|
|
|
Public Const _IsControl As Boolean = True
|
|
Public Const _IsVirtual As Boolean = True
|
|
Public Const _Group As String = "Network"
|
|
Public Const _Properties As String = "Host,Port,User,Password,Encrypt{Net.None;SSL;TLS}=None,Authentication{SmtpClient.Automatic;Login;Plain;CramMD5}"
|
|
|
|
Public Enum Automatic = 0, Login = 1, Plain = 2, CramMD5 = 3
|
|
|
|
Property Debug As Boolean
|
|
|
|
Property Host As String
|
|
Property Port As Integer
|
|
Property User As String
|
|
Property Password As String
|
|
Property Encrypt As Integer
|
|
Property Authentication As Integer
|
|
|
|
Property From As String
|
|
Property Subject As String
|
|
Property Body As String
|
|
|
|
Property MessageId As String
|
|
Property InReplyTo As String
|
|
|
|
Property Read To As String[]
|
|
Property Read Cc As String[]
|
|
Property Read Bcc As String[]
|
|
|
|
Property Alternative As Boolean
|
|
Property Read Count As Integer
|
|
|
|
Private $bDebug As Boolean
|
|
Private $sHost As String
|
|
Private $iPort As Integer
|
|
Private $sUser As String
|
|
Private $sPassword As String
|
|
|
|
Private $sFrom As String
|
|
Private $sSubject As String
|
|
Private $sBody As String
|
|
|
|
Private $aTo As New String[]
|
|
Private $aCc As New String[]
|
|
Private $aBcc As New String[]
|
|
|
|
Private $aPart As New SmtpPart[]
|
|
Private $bAlternative As Boolean
|
|
Private $hSession As SmtpSession
|
|
Private $iEncrypt As Integer
|
|
|
|
Private $cCustomHeaders As New String[]
|
|
Private $sMessageId As String
|
|
Private $sInReplyTo As String
|
|
Private $iAuth As Integer
|
|
|
|
Static Public Sub _init()
|
|
|
|
' Compatibility with the old gb.net.smtp component that didn't require it
|
|
Component.Load("gb.net")
|
|
|
|
End
|
|
|
|
|
|
Public Sub Add(Data As String, Optional MimeType As String, Name As String)
|
|
|
|
Dim hPart As SmtpPart
|
|
|
|
'If IsMissing(Name) Then Name = "Part #" & CStr($aPart.Count + 1)
|
|
|
|
hPart = New SmtpPart(MimeType, Name)
|
|
hPart.Data = Data
|
|
|
|
$aPart.Add(hPart)
|
|
|
|
End
|
|
|
|
Private Function Debug_Read() As Boolean
|
|
|
|
Return $bDebug
|
|
|
|
End
|
|
|
|
Private Sub Debug_Write(Value As Boolean)
|
|
|
|
$bDebug = Value
|
|
|
|
End
|
|
|
|
Private Function Host_Read() As String
|
|
|
|
Return $sHost
|
|
|
|
End
|
|
|
|
Private Sub Host_Write(Value As String)
|
|
|
|
$sHost = Value
|
|
|
|
End
|
|
|
|
Private Function Port_Read() As Integer
|
|
|
|
Return $iPort
|
|
|
|
End
|
|
|
|
Private Sub Port_Write(Value As Integer)
|
|
|
|
$iPort = Value
|
|
|
|
End
|
|
|
|
Private Function User_Read() As String
|
|
|
|
Return $sUser
|
|
|
|
End
|
|
|
|
Private Sub User_Write(Value As String)
|
|
|
|
$sUser = Value
|
|
|
|
End
|
|
|
|
Private Function Password_Read() As String
|
|
|
|
Return $sPassword
|
|
|
|
End
|
|
|
|
Private Sub Password_Write(Value As String)
|
|
|
|
$sPassword = Value
|
|
|
|
End
|
|
|
|
Private Function From_Read() As String
|
|
|
|
Return $sFrom
|
|
|
|
End
|
|
|
|
Private Sub From_Write(Value As String)
|
|
|
|
$sFrom = Value
|
|
|
|
End
|
|
|
|
Private Function Subject_Read() As String
|
|
|
|
Return $sSubject
|
|
|
|
End
|
|
|
|
Private Sub Subject_Write(Value As String)
|
|
|
|
$sSubject = Value
|
|
|
|
End
|
|
|
|
Private Function Body_Read() As String
|
|
|
|
Return $sBody
|
|
|
|
End
|
|
|
|
Private Sub Body_Write(Value As String)
|
|
|
|
$sBody = Value
|
|
|
|
End
|
|
|
|
Private Function To_Read() As String[]
|
|
|
|
Return $aTo
|
|
|
|
End
|
|
|
|
Private Function Cc_Read() As String[]
|
|
|
|
Return $aCc
|
|
|
|
End
|
|
|
|
Private Function Bcc_Read() As String[]
|
|
|
|
Return $aBcc
|
|
|
|
End
|
|
|
|
Private Function Alternative_Read() As Boolean
|
|
|
|
Return $bAlternative
|
|
|
|
End
|
|
|
|
Private Sub Alternative_Write(Value As Boolean)
|
|
|
|
$bAlternative = Value
|
|
|
|
End
|
|
|
|
Private Function Count_Read() As Integer
|
|
|
|
Return $aPart.Count
|
|
|
|
End
|
|
|
|
Private Sub FormatAddress(sAdr As String) As String
|
|
|
|
sAdr = Trim(sAdr)
|
|
If Not sAdr Then Return
|
|
If sAdr Not Like "* <*>" Then Return "<" & sAdr & ">"
|
|
Return sAdr
|
|
|
|
End
|
|
|
|
Private Sub ExtractAddress(sAdr As String) As String
|
|
|
|
Dim iPos As Integer
|
|
|
|
sAdr = Trim(sAdr)
|
|
If Not sAdr Then Return
|
|
If sAdr Not Like "* <*>" Then Return "<" & sAdr & ">"
|
|
iPos = InStr(sAdr, "<")
|
|
Return Mid$(sAdr, iPos)
|
|
|
|
End
|
|
|
|
Private Sub BeginSession()
|
|
|
|
Dim hPart As SmtpPart
|
|
Dim bParent As Boolean
|
|
|
|
Select Case $iEncrypt
|
|
Case Net.None
|
|
$hSession = New TcpSession($bDebug)
|
|
Case Net.SSL
|
|
$hSession = New SslSession($bDebug)
|
|
Case Net.TLS
|
|
$hSession = New TlsSession($bDebug)
|
|
Case Else
|
|
Error.Raise("Unknown encryption")
|
|
End Select
|
|
|
|
'$hSession._Debug = $bDebug
|
|
|
|
If $sBody Then
|
|
|
|
hPart = New SmtpPart
|
|
hPart.Data = $sBody
|
|
$aPart.Add(hPart, 0)
|
|
|
|
Endif
|
|
|
|
If $aPart.Count > 1 Then
|
|
|
|
hPart = New SmtpPart("multipart/" & If($bAlternative, "alternative", "mixed"), "Main part")
|
|
hPart.Data = "This is a MIME " & hPart.Mime & " message."
|
|
$aPart.Add(hPart, 0)
|
|
bParent = True
|
|
|
|
Endif
|
|
|
|
End
|
|
|
|
Private Sub EndSession()
|
|
|
|
$hSession.Send("QUIT")
|
|
$hSession.Disconnect
|
|
|
|
End
|
|
|
|
Private Sub GetDomainName() As String
|
|
|
|
Dim sName As String
|
|
|
|
sName = System.Domain
|
|
If sName And If sName <> "(none)" Then
|
|
sName &= "."
|
|
Else
|
|
sName = ""
|
|
Endif
|
|
|
|
Return sName & System.Host
|
|
|
|
End
|
|
|
|
Private Sub Connect()
|
|
|
|
Dim sData As String
|
|
|
|
$hSession.Connect(Me, $sHost, $iPort)
|
|
|
|
If $iEncrypt <> Net.TLS Then
|
|
' greetings
|
|
$hSession.GetLine(True)
|
|
Endif
|
|
|
|
sData = $hSession.Send("EHLO " & GetDomainName(), True)
|
|
If $hSession.LastCode <> "250" Then Error.Raise("EHLO command failed")
|
|
|
|
Catch
|
|
|
|
Error.Raise("Unable to connect to the SMTP server: " & Error.Text)
|
|
|
|
End
|
|
|
|
Private Sub Authenticate()
|
|
|
|
Dim sChallenge64, sChallenge, sKey, sCommand, sResponse, sDigestHex As String
|
|
|
|
If Not $sUser Then Return
|
|
|
|
If $iAuth = Automatic Or If $iAuth = Login Then
|
|
|
|
' AUTH LOGIN
|
|
$hSession.Send("AUTH LOGIN")
|
|
If $hSession.LastCode = "334" Then
|
|
$hSession.Send(Base64$($sUser))
|
|
If $hSession.LastCode = "334" Then
|
|
$hSession.Send(Base64$($sPassword))
|
|
If $hSession.LastCode = "235" Then Return
|
|
Endif
|
|
Endif
|
|
|
|
If $iAuth Then Goto _FAIL
|
|
|
|
Endif
|
|
|
|
If $iAuth = Automatic Or If $iAuth = Plain Then
|
|
|
|
' AUTH PLAIN
|
|
$hSession.Send("AUTH PLAIN")
|
|
If $hSession.LastCode <> "334" Then
|
|
$hSession.Send("AUTH PLAIN " & Base64$($sUser & Chr$(0) & $sUser & Chr$(0) & $sPassword), True)
|
|
Else
|
|
$hSession.Send(Base64$($sUser & Chr$(0) & $sUser & Chr$(0) & $sPassword), True)
|
|
Endif
|
|
If $hSession.LastCode = "235" Then Return
|
|
|
|
If $iAuth Then Goto _FAIL
|
|
|
|
Endif
|
|
|
|
If $iAuth = Automatic Or If $iAuth = CramMD5 Then
|
|
|
|
' CRAM-MD5
|
|
$hSession.Send("AUTH CRAM-MD5")
|
|
'If $hSession.LastCode = "334" Then Print "LastAnswer = "; $hSession.LastAnswer
|
|
|
|
sChallenge64 = Split($hSession.LastAnswer, " ")[1]
|
|
sChallenge = UnBase64(sChallenge64)
|
|
sKey = $sPassword
|
|
|
|
'sCommand = "echo -n " & Shell$(sChallenge) & " | openssl md5 -hmac " & Shell$(sKey)
|
|
sCommand = "openssl md5 -hmac " & Shell$(sKey) & " << EOF\n" & sChallenge
|
|
Shell sCommand To sDigestHex
|
|
|
|
sDigestHex = Trim(Split(sDigestHex, "=")[1])
|
|
sResponse = Base64($sUser & sDigestHex)
|
|
|
|
$hSession.Send(sResponse)
|
|
If $hSession.LastCode = "235" Then Return
|
|
|
|
If $iAuth Then Goto _FAIL
|
|
|
|
Endif
|
|
|
|
_FAIL:
|
|
|
|
Error.Raise("Authentication failed (" & $hSession.LastCode & ")")
|
|
|
|
Catch
|
|
|
|
Error.Raise("Unable to authenticate: " & Error.Text)
|
|
|
|
End
|
|
|
|
Private Sub SendRecipients()
|
|
|
|
Dim aRcpt As String[]
|
|
Dim sRcpt As String
|
|
Dim sAdr As String
|
|
|
|
$hSession.Send("MAIL FROM: " & ExtractAddress($sFrom))
|
|
If $hSession.LastCode >= "300" Then Error.Raise("Sender rejected")
|
|
|
|
aRcpt = $aTo.Copy()
|
|
aRcpt.Insert($aCC)
|
|
aRcpt.Insert($aBcc)
|
|
|
|
For Each sRcpt In aRcpt
|
|
|
|
sAdr = ExtractAddress(sRcpt)
|
|
If Not sAdr Then Continue
|
|
|
|
$hSession.Send("RCPT TO: " & sAdr)
|
|
If $hSession.LastCode >= "300" Then
|
|
Error.Raise("Recipient rejected: " & sAdr)
|
|
Endif
|
|
|
|
Next
|
|
|
|
Catch
|
|
|
|
Error.Raise("Unable to send recipients: " & Error.Text)
|
|
|
|
End
|
|
|
|
Static Public Sub FormatDate({Date} As Date) As String
|
|
|
|
Dim dDate As Date = {Date}
|
|
|
|
If Not dDate Then dDate = Now
|
|
dDate -= Frac(Date(Now)) ' Go to GMT
|
|
|
|
If Not $aDay Then
|
|
$aDay = ["Sun", "Mon", "Tue", "Wed", "Thu", "Fri", "Sat"]
|
|
$aMonth = ["Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec"]
|
|
Endif
|
|
|
|
Return $aDay[WeekDay(dDate)] & ", " & Format(Day(dDate), "00") & " " & $aMonth[Month(dDate) - 1] & " " & Year(dDate) & " " & Format(Time(dDate), "hh:nn:ss") & " GMT"
|
|
|
|
End
|
|
|
|
Public Sub AddHeader(Name As String, Value As String)
|
|
|
|
If Not Value Then Return
|
|
|
|
$cCustomHeaders.Add(Name)
|
|
$cCustomHeaders.Add(Value)
|
|
|
|
End
|
|
|
|
Private Sub SendHeaders()
|
|
|
|
Dim I As Integer
|
|
|
|
If $sMessageId Then $hSession.PrintHeader("Message-ID", "<" & $sMessageId & ">")
|
|
|
|
$hSession.PrintHeader("Date", FormatDate(Now))
|
|
|
|
$hSession.PrintHeader("From", FormatAddress($sFrom))
|
|
|
|
$hSession.PrintHeader("Subject", $sSubject)
|
|
|
|
If $aTo.Count Then $hSession.PrintHeader("To", $aTo.Join(","))
|
|
If $aCc.Count Then $hSession.PrintHeader("CC", $aCc.Join(","))
|
|
|
|
If $sInReplyTo Then
|
|
$hSession.PrintHeader("References", "<" & $sInReplyTo & ">")
|
|
$hSession.PrintHeader("In-Reply-To", "<" & $sInReplyTo & ">")
|
|
Endif
|
|
|
|
For I = 0 To $cCustomHeaders.Max Step 2
|
|
$hSession.PrintHeader($cCustomHeaders[I], $cCustomHeaders[I + 1])
|
|
Next
|
|
|
|
$hSession.Print("MIME-Version: 1.0")
|
|
|
|
If $aPart.Count = 0 Then $hSession.Print("Content-Type: text/plain; charset=\"us-ascii\"")
|
|
|
|
Catch
|
|
|
|
Error.Raise("Unable to send headers: " & Error.Text)
|
|
|
|
End
|
|
|
|
Public Sub Send()
|
|
|
|
Dim I As Integer
|
|
Dim sErr As String
|
|
|
|
If Not $sFrom Then
|
|
Error.Raise("The From property must be set")
|
|
Return
|
|
Endif
|
|
|
|
BeginSession
|
|
|
|
Connect
|
|
|
|
Authenticate
|
|
|
|
SendRecipients
|
|
|
|
$hSession.Send("DATA")
|
|
If $hSession.LastCode <> "354" Then Error.Raise("DATA command failed")
|
|
|
|
SendHeaders
|
|
|
|
$aPart[0].SendHeaders($hSession)
|
|
$aPart[0].Send($hSession)
|
|
|
|
If $aPart.Count > 1 Then
|
|
|
|
For I = 1 To $aPart.Max
|
|
|
|
$hSession.Print("--" & $aPart[0].Boundary)
|
|
$aPart[I].SendHeaders($hSession)
|
|
$aPart[I].Send($hSession)
|
|
|
|
Next
|
|
|
|
$hSession.Print("--" & $aPart[0].Boundary & "--")
|
|
|
|
Endif
|
|
|
|
$hSession.Send(".")
|
|
If $hSession.LastCode >= "300" Then
|
|
Error.Raise("Body rejected")
|
|
Endif
|
|
|
|
EndSession
|
|
|
|
Catch
|
|
|
|
sErr = Error.Text
|
|
Try $hSession.Disconnect
|
|
Error.Raise("Unable to send mail: " & sErr)
|
|
|
|
End
|
|
|
|
|
|
|
|
Private Function Encrypt_Read() As Integer
|
|
|
|
Return $iEncrypt
|
|
|
|
End
|
|
|
|
Private Sub Encrypt_Write(Value As Integer)
|
|
|
|
$iEncrypt = Value
|
|
|
|
End
|
|
|
|
Private Function MessageId_Read() As String
|
|
|
|
Return $sMessageId
|
|
|
|
End
|
|
|
|
Private Sub MessageId_Write(Value As String)
|
|
|
|
$sMessageId = Value
|
|
|
|
|
|
End
|
|
|
|
Private Function InReplyTo_Read() As String
|
|
|
|
Return $sInReplyTo
|
|
|
|
End
|
|
|
|
Private Sub InReplyTo_Write(Value As String)
|
|
|
|
$sInReplyTo = Value
|
|
|
|
End
|
|
|
|
Private Function Authentication_Read() As Integer
|
|
|
|
Return $iAuth
|
|
|
|
End
|
|
|
|
Private Sub Authentication_Write(Value As Integer)
|
|
|
|
$iAuth = Value
|
|
|
|
End
|