' 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