AppStd/Modules
8
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

MS Rekompilierung

Browse Source
This commit is contained in:
Developer01
2025-11-28 10:42:33 +01:00
parent ceb688fc3f
commit 7b91aac5e9
12 changed files with 322 additions and 236 deletions
Download Patch File Download Diff File Expand all files Collapse all files

187
Messaging/Mail/MailSession.vb
View File

@@ -1,4 +1,5 @@
Imports System.Net.Security
Imports System.IdentityModel.Tokens
Imports System.Net.Security
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Logging
Imports Limilabs.Client
@@ -11,7 +12,6 @@ Namespace Mail
Inherits BaseClass
Public ReadOnly Client As ClientBase
Public ReadOnly OAuth2 As OAuth2
Public Const AUTH_SSL = "SSL"
Public Const AUTH_STARTTLS = "STARTTLS"
@@ -19,9 +19,7 @@ Namespace Mail
Public Const AUTH_NONE = "NONE"
Public Const AUTH_OAUTH2 = "OAUTH2"
Private Const SMTP_IGNORED_ERRORS As SslPolicyErrors =
SslPolicyErrors.RemoteCertificateChainErrors Or ' self-signed
SslPolicyErrors.RemoteCertificateNameMismatch ' name mismatch
Private Const SMTP_IGNORED_ERRORS As SslPolicyErrors = SslPolicyErrors.RemoteCertificateChainErrors Or SslPolicyErrors.RemoteCertificateNameMismatch
Private _Session As SessionInfo
@@ -56,7 +54,7 @@ Namespace Mail
Public Property EnableTls1_1 As Boolean = False
Public Property EnableTls1_2 As Boolean = False
' Not available in .NET 4.6.2
' Not available in .NET4.6.2
'Public Property EnableTls1_3 As Boolean = False
End Class
@@ -71,12 +69,12 @@ Namespace Mail
''' <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
}
.Server = pServer,
.Port = pPort,
.User = pUser,
.Password = pPassword,
.AuthType = pAuthType
}
Logger.Debug("Connecting to Server..")
Logger.Debug("Server: [{0}]", oSession.Server)
@@ -92,17 +90,23 @@ Namespace Mail
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 = OAuth2.O365_SERVER,
.ClientId = pClientId,
.ClientSecret = pClientSecret,
.TenantId = pTenantId,
.User = pUser,
.AuthType = AUTH_OAUTH2
}
.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)
@@ -120,61 +124,52 @@ Namespace Mail
If pOptions.EnableDefault Then
Logger.Debug("Enabling Default TLS Version")
Client.SSLConfiguration.EnabledSslProtocols = Security.Authentication.SslProtocols.Default
Client.SSLConfiguration.EnabledSslProtocols = System.Security.Authentication.SslProtocols.Default
Else
Logger.Debug("Disabling Default TLS Version")
Client.SSLConfiguration.EnabledSslProtocols = Security.Authentication.SslProtocols.None
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 Version 1.1")
Client.SSLConfiguration.EnabledSslProtocols = Client.SSLConfiguration.EnabledSslProtocols Or Security.Authentication.SslProtocols.Tls11
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 Version 1.2")
Client.SSLConfiguration.EnabledSslProtocols = Client.SSLConfiguration.EnabledSslProtocols Or Security.Authentication.SslProtocols.Tls12
Logger.Debug("Enabling TLS Version1.2")
Client.SSLConfiguration.EnabledSslProtocols = Client.SSLConfiguration.EnabledSslProtocols Or System.Security.Authentication.SslProtocols.Tls12
End If
' This is not available in .NET 4.6.2, only in .NET 4.7/4.8
'If pOptions.EnableTls1_3 Then
' Logger.Debug("Enabling TLS Version 1.3")
' oSession.SSLConfiguration.EnabledSslProtocols = oSession.SSLConfiguration.EnabledSslProtocols Or Security.Authentication.SslProtocols.Tls13
'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 = Client
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)
Logger.Debug("Connecting with [OAuth2/ConnectSSL] on [{0}]", pSession.Server)
oClient.ConnectSSL(pSession.Server)
Else
Throw New ApplicationException("Only OAuth2 for IMAP is not yet supported!")
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)
Session.Error = ex
Return Session
pSession.Error = ex
Return pSession
End Try
ElseIf pSession.AuthType = AUTH_SSL Then
Try
' Port 465 ist der SMTP-SSL-Port, wird bei der WISAG verwendet, aber veraltet
' Port 993 ist der IMAP-SSL-Port, zum Abholen der Mails
If pSession.Port = 465 Or pSession.Port = 993 Then
Logger.Debug("Connecting with [SSL/ConnectSSL] on [{0}/{1}]", pSession.Server, pSession.Port)
Client.ConnectSSL(pSession.Server, pSession.Port)
Else
Logger.Debug("Connecting with [SSL/Connect] on [{0}/{1}]", pSession.Server, pSession.Port)
Client.Connect(pSession.Server, pSession.Port)
End If
' 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
@@ -182,21 +177,32 @@ Namespace Mail
Logger.Warn($"Error-message: {ex.Message}")
Logger.Error(ex)
Session.Error = ex
Return Session
pSession.Error = ex
Return pSession
End Try
ElseIf Session.AuthType = AUTH_SSLTLS Or Session.AuthType = AUTH_STARTTLS Then
ElseIf pSession.AuthType = AUTH_SSLTLS Then
Try
If pSession.Port = 993 Then
Logger.Debug("Connecting with [STARTTLS/ConnectSSL] on [{0}/{1}]", pSession.Server, pSession.Port)
Client.ConnectSSL(pSession.Server, pSession.Port)
Else
Logger.Debug("Connecting with [STARTTLS/Connect] on [{0}/{1}]", pSession.Server, pSession.Port)
Client.Connect(pSession.Server, pSession.Port)
End If
Logger.Debug("Connection (AUTH_SSLTLS or AUTH_STARTTLS) Successful!")
' 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)
@@ -205,8 +211,7 @@ Namespace Mail
DoSTARTTLS(Client)
Logger.Debug("STARTTLS Successful!")
Else
Logger.Debug("Server does not support STARTTLS. Enabling TLS1.2 instead.")
Client.SSLConfiguration.EnabledSslProtocols = Security.Authentication.SslProtocols.Tls12
Throw New ApplicationException("Server does not support STARTTLS on this endpoint.")
End If
Catch ex As Exception
@@ -219,11 +224,11 @@ Namespace Mail
Else
Try
Logger.Debug("Auth type [{0}]. Using PLAINTEXT connection.", Session.AuthType)
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}]!", Session.AuthType)
Logger.Warn("Unexpected Error in ConnectToServer with Auth type [{0}]!", pSession.AuthType)
Logger.Error(ex)
pSession.Error = ex
@@ -237,8 +242,7 @@ Namespace Mail
Logger.Info("Logging in with user [{0}] and Auth Type [{1}]", pSession.User, pSession.AuthType)
If pSession.AuthType = AUTH_OAUTH2 Then
' SessionInfo.Password will be the access token that was obtained
' in the OAuth2 flow before
' Use OAuth2 token
DoUseBestLogin_OAuth2(Client, pSession)
Else
DoUseBestLogin_BasicAuth(Client, pSession.User, pSession.Password)
@@ -293,7 +297,7 @@ Namespace Mail
End If
End Function
Private Function SupportsSTARTTLS(pClient As ClientBase)
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
@@ -329,16 +333,61 @@ Namespace Mail
Private Sub DoUseBestLogin_OAuth2(pClient As ClientBase, pSession As SessionInfo)
Logger.Debug("Logging in with O365 OAuth2")
If TypeOf pClient Is Imap Then
Dim oOAuth = New OAuth2(LogConfig, pSession.TenantId, pSession.ClientId, pSession.ClientSecret)
Dim oAccessToken = oOAuth.GetAccessToken()
Dim oOAuth = New OAuth2(LogConfig, pSession.TenantId, pSession.ClientId, pSession.ClientSecret)
Dim oAccessToken = oOAuth.GetAccessToken()
DirectCast(pClient, Imap).LoginOAUTH2(pSession.User, oAccessToken)
' 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()