412 lines
17 KiB
VB.net
412 lines
17 KiB
VB.net
Imports System.IdentityModel.Tokens
|
||
Imports System.Net.Security
|
||
Imports DigitalData.Modules.Base
|
||
Imports DigitalData.Modules.Logging
|
||
Imports Limilabs.Client
|
||
Imports Limilabs.Client.IMAP
|
||
Imports Limilabs.Client.SMTP
|
||
Imports Microsoft.Identity.Client
|
||
|
||
Namespace Mail
|
||
Public Class MailSession
|
||
Inherits BaseClass
|
||
|
||
Public ReadOnly Client As ClientBase
|
||
|
||
Public Const AUTH_SSL = "SSL"
|
||
Public Const AUTH_STARTTLS = "STARTTLS"
|
||
Public Const AUTH_SSLTLS = "SSL/TLS"
|
||
Public Const AUTH_NONE = "NONE"
|
||
Public Const AUTH_OAUTH2 = "OAUTH2"
|
||
|
||
Private Const SMTP_IGNORED_ERRORS As SslPolicyErrors = SslPolicyErrors.RemoteCertificateChainErrors Or SslPolicyErrors.RemoteCertificateNameMismatch
|
||
|
||
Private _Session As SessionInfo
|
||
|
||
Public ReadOnly Property Session As SessionInfo
|
||
Get
|
||
Return _Session
|
||
End Get
|
||
End Property
|
||
|
||
Public Sub New(pLogConfig As LogConfig, pClient As ClientBase)
|
||
MyBase.New(pLogConfig)
|
||
Client = pClient
|
||
End Sub
|
||
|
||
Public Class SessionInfo
|
||
Public Server As String
|
||
Public Port As Integer
|
||
Public User As String
|
||
Public Password As String
|
||
Public AuthType As String
|
||
|
||
Public ClientId As String
|
||
Public TenantId As String
|
||
Public ClientSecret As String
|
||
|
||
Public [Error] As Exception
|
||
Public Connected As Boolean = False
|
||
End Class
|
||
|
||
Public Class MailSessionOptions
|
||
Public Property EnableDefault As Boolean = True
|
||
Public Property EnableTls1_1 As Boolean = False
|
||
Public Property EnableTls1_2 As Boolean = False
|
||
|
||
' Not available in .NET4.6.2
|
||
'Public Property EnableTls1_3 As Boolean = False
|
||
End Class
|
||
|
||
''' <summary>
|
||
''' Start a connection with the specified server and return the session info.
|
||
''' </summary>
|
||
''' <param name="pServer"></param>
|
||
''' <param name="pPort"></param>
|
||
''' <param name="pUser"></param>
|
||
''' <param name="pPassword"></param>
|
||
''' <param name="pAuthType"></param>
|
||
''' <returns></returns>
|
||
Public Function ConnectToServerWithBasicAuth(pServer As String, pPort As Integer, pUser As String, pPassword As String, pAuthType As String, pOptions As MailSessionOptions) As SessionInfo
|
||
Dim oSession = New SessionInfo With {
|
||
.Server = pServer,
|
||
.Port = pPort,
|
||
.User = pUser,
|
||
.Password = pPassword,
|
||
.AuthType = pAuthType
|
||
}
|
||
|
||
Logger.Debug("Connecting to Server..")
|
||
Logger.Debug("Server: [{0}]", oSession.Server)
|
||
Logger.Debug("Port: [{0}]", oSession.Port)
|
||
Logger.Debug("User: [{0}]", oSession.User)
|
||
Logger.Debug("AuthType: [{0}]", oSession.AuthType)
|
||
|
||
_Session = oSession
|
||
|
||
Logger.Debug("Initializing Connection with Auth type [{0}].", oSession.AuthType)
|
||
|
||
Return ConnectToServer(oSession, pOptions)
|
||
End Function
|
||
|
||
Public Function ConnectToServerWithO365OAuth(pUser As String, pClientId As String, pTenantId As String, pClientSecret As String, pOptions As MailSessionOptions) As SessionInfo
|
||
' Choose server/port based on the client type
|
||
Dim server As String = If(TypeOf Client Is Smtp, "smtp.office365.com", OAuth2.O365_SERVER)
|
||
Dim port As Integer = If(TypeOf Client Is Imap, 993, If(TypeOf Client Is Smtp, 587, 993))
|
||
|
||
Dim oSession = New SessionInfo With {
|
||
.Server = server,
|
||
.Port = port,
|
||
.ClientId = pClientId,
|
||
.ClientSecret = pClientSecret,
|
||
.TenantId = pTenantId,
|
||
.User = pUser,
|
||
.AuthType = AUTH_OAUTH2
|
||
}
|
||
|
||
Logger.Debug("Connecting to Server..")
|
||
Logger.Debug("Server: [{0}]", oSession.Server)
|
||
Logger.Debug("Port: [{0}]", oSession.Port)
|
||
Logger.Debug("User: [{0}]", oSession.User)
|
||
Logger.Debug("ClientId: [{0}]", oSession.ClientId)
|
||
Logger.Debug("TenantId: [{0}]", oSession.TenantId)
|
||
Logger.Debug("AuthType: [{0}]", oSession.AuthType)
|
||
|
||
_Session = oSession
|
||
|
||
Logger.Debug("Initializing Connection with Auth type [{0}].", oSession.AuthType)
|
||
|
||
Return ConnectToServer(oSession, pOptions)
|
||
End Function
|
||
|
||
Private Function ConnectToServer(pSession As SessionInfo, pOptions As MailSessionOptions) As SessionInfo
|
||
AddHandler Client.ServerCertificateValidate, AddressOf Session_ServerCertificateValidate
|
||
|
||
If pOptions.EnableDefault Then
|
||
Logger.Debug("Enabling Default TLS Version")
|
||
Client.SSLConfiguration.EnabledSslProtocols = System.Security.Authentication.SslProtocols.Default
|
||
Else
|
||
Logger.Debug("Disabling Default TLS Version")
|
||
Client.SSLConfiguration.EnabledSslProtocols = System.Security.Authentication.SslProtocols.None
|
||
End If
|
||
|
||
' Set TLS Version manually if requested
|
||
If pOptions.EnableTls1_1 Then
|
||
Logger.Debug("Enabling TLS Version1.1")
|
||
Client.SSLConfiguration.EnabledSslProtocols = Client.SSLConfiguration.EnabledSslProtocols Or System.Security.Authentication.SslProtocols.Tls11
|
||
End If
|
||
|
||
If pOptions.EnableTls1_2 Then
|
||
Logger.Debug("Enabling TLS Version1.2")
|
||
Client.SSLConfiguration.EnabledSslProtocols = Client.SSLConfiguration.EnabledSslProtocols Or System.Security.Authentication.SslProtocols.Tls12
|
||
End If
|
||
|
||
Logger.Debug("Enabled Encryption Protocols: [{0}]", Client.SSLConfiguration.EnabledSslProtocols)
|
||
|
||
If pSession.AuthType = AUTH_OAUTH2 Then
|
||
Try
|
||
If TypeOf Client Is Imap Then
|
||
Dim oClient As Imap = DirectCast(Client, Imap)
|
||
Logger.Debug("Connecting with [OAuth2/IMAP/ConnectSSL] on [{0}/{1}]", pSession.Server, If(pSession.Port > 0, pSession.Port, 993))
|
||
oClient.ConnectSSL(pSession.Server) ', If(pSession.Port > 0, pSession.Port, 993)
|
||
|
||
ElseIf TypeOf Client Is Smtp Then
|
||
Dim s As Smtp = DirectCast(Client, Smtp)
|
||
Logger.Debug("Connecting with [OAuth2/SMTP/STARTTLS] on [{0}/{1}]", pSession.Server, If(pSession.Port > 0, pSession.Port, 587))
|
||
s.Connect(pSession.Server, If(pSession.Port > 0, pSession.Port, 587))
|
||
s.StartTLS()
|
||
End If
|
||
|
||
Catch ex As Exception
|
||
Logger.Warn("Unexpected Error in ConnectToServer with Auth type OAuth2!")
|
||
Logger.Error(ex)
|
||
|
||
pSession.Error = ex
|
||
Return pSession
|
||
End Try
|
||
|
||
ElseIf pSession.AuthType = AUTH_SSL Then
|
||
Try
|
||
' SSL: always connect with SSL immediately
|
||
Logger.Debug("Connecting with [SSL/ConnectSSL] on [{0}/{1}]", pSession.Server, pSession.Port)
|
||
Client.ConnectSSL(pSession.Server, pSession.Port)
|
||
Logger.Debug("Connection (AUTH_SSL) Successful!")
|
||
|
||
Catch ex As Exception
|
||
Logger.Warn("Unexpected Error in ConnectToServer with Auth type SSL!")
|
||
Logger.Warn($"Error-message: {ex.Message}")
|
||
Logger.Error(ex)
|
||
|
||
pSession.Error = ex
|
||
Return pSession
|
||
End Try
|
||
|
||
ElseIf pSession.AuthType = AUTH_SSLTLS Then
|
||
|
||
Try
|
||
' SSL/TLS: same as SSL, explicit branch for clarity
|
||
Logger.Debug("Connecting with [SSL/TLS/ConnectSSL] on [{0}/{1}]", pSession.Server, pSession.Port)
|
||
Client.ConnectSSL(pSession.Server, pSession.Port)
|
||
Logger.Debug("Connection (AUTH_SSLTLS) Successful!")
|
||
|
||
Catch ex As Exception
|
||
Logger.Warn("Unexpected Error in ConnectToServer with Auth type SSL/TLS!")
|
||
Logger.Error(ex)
|
||
|
||
pSession.Error = ex
|
||
Return pSession
|
||
End Try
|
||
|
||
ElseIf pSession.AuthType = AUTH_STARTTLS Then
|
||
|
||
Try
|
||
' STARTTLS: connect plain and then upgrade
|
||
Logger.Debug("Connecting with [STARTTLS/Connect] on [{0}/{1}]", pSession.Server, pSession.Port)
|
||
Client.Connect(pSession.Server, pSession.Port)
|
||
|
||
Dim oSupportsSTARTTLS As Boolean = SupportsSTARTTLS(Client)
|
||
Logger.Debug("Server supports STARTTLS: [{0}]", oSupportsSTARTTLS)
|
||
|
||
If oSupportsSTARTTLS Then
|
||
DoSTARTTLS(Client)
|
||
Logger.Debug("STARTTLS Successful!")
|
||
Else
|
||
Throw New ApplicationException("Server does not support STARTTLS on this endpoint.")
|
||
End If
|
||
|
||
Catch ex As Exception
|
||
Logger.Warn("Unexpected Error in ConnectToServer with Auth type STARTTLS!")
|
||
Logger.Error(ex)
|
||
|
||
pSession.Error = ex
|
||
Return pSession
|
||
End Try
|
||
|
||
Else
|
||
Try
|
||
Logger.Debug("Auth type [{0}]. Using PLAINTEXT connection.", pSession.AuthType)
|
||
Client.Connect(pSession.Server, pSession.Port, useSSL:=False)
|
||
|
||
Catch ex As Exception
|
||
Logger.Warn("Unexpected Error in ConnectToServer with Auth type [{0}]!", pSession.AuthType)
|
||
Logger.Error(ex)
|
||
|
||
pSession.Error = ex
|
||
Return pSession
|
||
End Try
|
||
|
||
End If
|
||
|
||
Try
|
||
If pSession.User <> String.Empty Then
|
||
Logger.Info("Logging in with user [{0}] and Auth Type [{1}]", pSession.User, pSession.AuthType)
|
||
|
||
If pSession.AuthType = AUTH_OAUTH2 Then
|
||
' Use OAuth2 token
|
||
DoUseBestLogin_OAuth2(Client, pSession)
|
||
Else
|
||
DoUseBestLogin_BasicAuth(Client, pSession.User, pSession.Password)
|
||
End If
|
||
|
||
End If
|
||
Catch ex As Exception
|
||
Logger.Warn("Unexpected Error in ConnectToServer with Auth type [{0}]!", pSession.AuthType)
|
||
Logger.Error(ex)
|
||
|
||
pSession.Error = ex
|
||
Return pSession
|
||
End Try
|
||
|
||
pSession.Connected = True
|
||
|
||
Return pSession
|
||
End Function
|
||
|
||
Public Function DisconnectFromServer() As Boolean
|
||
Try
|
||
If Client IsNot Nothing Then
|
||
Logger.Debug("Closing connection to Server [{0}].", Session.Server)
|
||
DoClose(Client)
|
||
Session.Connected = False
|
||
Logger.Info("Connection to Server [{0}] closed.", Session.Server)
|
||
Else
|
||
Logger.Debug("No connection currently open. Exiting.")
|
||
End If
|
||
|
||
Return True
|
||
|
||
Catch ex As Exception
|
||
Logger.Error(ex)
|
||
Return False
|
||
|
||
End Try
|
||
End Function
|
||
|
||
Public Function TestLogin(pServer As String, pPort As Integer, pUser As String, pPassword As String, pAuthType As String, pOptions As MailSessionOptions) As Boolean
|
||
Dim oInfo = ConnectToServerWithBasicAuth(pServer, pPort, pUser, pPassword, pAuthType, pOptions)
|
||
If oInfo.Connected Then
|
||
If DisconnectFromServer() Then
|
||
Return True
|
||
Else
|
||
Logger.Warn("Login Test failed while disconnecting.")
|
||
Return False
|
||
End If
|
||
Else
|
||
Logger.Warn("Login Test Failed while connecting.")
|
||
Return False
|
||
End If
|
||
End Function
|
||
|
||
Private Function SupportsSTARTTLS(pClient As ClientBase) As Boolean
|
||
If TypeOf pClient Is Smtp Then
|
||
Return DirectCast(pClient, Smtp).SupportedExtensions.Contains(SmtpExtension.StartTLS)
|
||
ElseIf TypeOf pClient Is Imap Then
|
||
Return DirectCast(pClient, Imap).SupportedExtensions.Contains(ImapExtension.StartTLS)
|
||
Else
|
||
Logger.Error("Unknown session type: [{0}]", pClient.GetType.ToString)
|
||
Return False
|
||
End If
|
||
End Function
|
||
|
||
Private Sub DoClose(pClient As ClientBase)
|
||
If TypeOf pClient Is Smtp Then
|
||
DirectCast(pClient, Smtp).Close()
|
||
ElseIf TypeOf pClient Is Imap Then
|
||
DirectCast(pClient, Imap).Close()
|
||
Else
|
||
Logger.Error("Unknown session type: [{0}]", pClient.GetType.ToString)
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub DoUseBestLogin_BasicAuth(pClient As ClientBase, pUserName As String, pPassword As String)
|
||
Logger.Debug("Logging in with Simple Auth")
|
||
|
||
If TypeOf pClient Is Smtp Then
|
||
DirectCast(pClient, Smtp).UseBestLogin(pUserName, pPassword)
|
||
ElseIf TypeOf pClient Is Imap Then
|
||
DirectCast(pClient, Imap).UseBestLogin(pUserName, pPassword)
|
||
Else
|
||
Logger.Error("Unknown session type: [{0}]", pClient.GetType.ToString)
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub DoUseBestLogin_OAuth2(pClient As ClientBase, pSession As SessionInfo)
|
||
Logger.Debug("Logging in with O365 OAuth2")
|
||
|
||
Dim oOAuth = New OAuth2(LogConfig, pSession.TenantId, pSession.ClientId, pSession.ClientSecret)
|
||
Dim oAccessToken = oOAuth.GetAccessToken()
|
||
|
||
' Diagnose token shape (delegated vs app-only)
|
||
Try
|
||
Dim parts = oAccessToken.Split("."c)
|
||
If parts.Length = 3 Then
|
||
Dim payloadJson = System.Text.Encoding.UTF8.GetString(Convert.FromBase64String(PadBase64(parts(1))))
|
||
If payloadJson.Contains("""scp""") Then
|
||
Logger.Debug("OAuth2 token contains 'scp' (delegated) – IMAP App-only erwartet 'roles'.")
|
||
ElseIf payloadJson.Contains("""roles""") Then
|
||
Logger.Debug("OAuth2 token contains 'roles' (application permissions).")
|
||
Else
|
||
Logger.Debug("OAuth2 token payload hat weder 'scp' noch 'roles'.")
|
||
End If
|
||
End If
|
||
Catch ex As Exception
|
||
Logger.Debug("Token-Payload konnte nicht gelesen werden: {0}", ex.Message)
|
||
End Try
|
||
|
||
If TypeOf pClient Is Imap Then
|
||
Dim i = DirectCast(pClient, Imap)
|
||
|
||
' Login mit Hilfsmethode; bei Abbruch explizit SASL XOAUTH2 probieren
|
||
Try
|
||
' Direkt versuchen, falls die verwendete Version LoginOAUTH2 unterstützt.
|
||
i.LoginOAUTH2(pSession.User, oAccessToken)
|
||
Catch ex As Exception
|
||
Logger.Warn("LoginOAUTH2 (IMAP) fehlgeschlagen: {0}", ex.Message)
|
||
Throw
|
||
End Try
|
||
ElseIf TypeOf pClient Is Smtp Then
|
||
Dim s = DirectCast(pClient, Smtp)
|
||
Try
|
||
s.LoginOAUTH2(pSession.User, oAccessToken)
|
||
Catch ex As Exception
|
||
Logger.Warn("LoginOAUTH2 (SMTP) fehlgeschlagen: {0}", ex.Message)
|
||
Throw
|
||
End Try
|
||
Else
|
||
Logger.Error("Unknown session type: [{0}]", pClient.GetType.ToString)
|
||
End If
|
||
End Sub
|
||
|
||
Private Shared Function PadBase64(input As String) As String
|
||
' Normalize Base64 URL-safe and pad to multiple of 4
|
||
If input Is Nothing Then Return String.Empty
|
||
Dim normalized As String = input.Replace("-", "+").Replace("_", "/")
|
||
Dim remainder As Integer = normalized.Length Mod 4
|
||
If remainder > 0 Then
|
||
normalized &= New String("="c, 4 - remainder)
|
||
End If
|
||
Return normalized
|
||
End Function
|
||
|
||
Private Sub DoSTARTTLS(pClient As ClientBase)
|
||
If TypeOf pClient Is Smtp Then
|
||
DirectCast(pClient, Smtp).StartTLS()
|
||
ElseIf TypeOf pClient Is Imap Then
|
||
DirectCast(pClient, Imap).StartTLS()
|
||
Else
|
||
Logger.Error("Unknown session type: [{0}]", pClient.GetType.ToString)
|
||
End If
|
||
End Sub
|
||
|
||
Private Sub Session_ServerCertificateValidate(sender As Object, e As ServerCertificateValidateEventArgs)
|
||
' i dont know why it works but it does
|
||
If (e.SslPolicyErrors And Not SMTP_IGNORED_ERRORS) = SslPolicyErrors.None Then
|
||
e.IsValid = True
|
||
Else
|
||
e.IsValid = False
|
||
End If
|
||
End Sub
|
||
End Class
|
||
End Namespace
|
||
|