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()

128
Messaging/Mail/OAuth2.vb
View File

@@ -1,58 +1,96 @@
Imports DigitalData.Modules.Base
Imports DigitalData.Modules.Logging
Imports DigitalData.Modules.Messaging.Mail.MailSession
Imports Limilabs.Client.IMAP
Imports Microsoft.Identity.Client
Public Class OAuth2
Inherits BaseClass
Namespace Mail
Public Class OAuth2
Inherits BaseClass
Private ReadOnly TenantId As String
Private ReadOnly ClientId As String
Private ReadOnly ClientSecret As String
Private ReadOnly _tenantId As String
Private ReadOnly _clientId As String
Private ReadOnly _clientSecret As String
Public Const O365_SCOPE = "https://outlook.office365.com/.default"
Public Const O365_SERVER = "outlook.office365.com"
Public Const O365_SERVER As String = "outlook.office365.com"
Public Const O365_SCOPE As String = "https://outlook.office365.com/.default"
Public Const O365_AUTHORITY_PREFIX As String = "https://login.microsoftonline.com/"
Private _AccessToken As String
Public ReadOnly Property AccessToken
Get
Return _AccessToken
End Get
End Property
Public Sub New(pLogConfig As LogConfig, tenantId As String, clientId As String, clientSecret As String)
MyBase.New(pLogConfig)
_tenantId = tenantId
_clientId = clientId
_clientSecret = clientSecret
End Sub
Public Sub New(pLogConfig As LogConfig, pTenantId As String, pClientId As String, pClientSecret As String)
MyBase.New(pLogConfig)
TenantId = pTenantId
ClientId = pClientId
ClientSecret = pClientSecret
End Sub
Public Function GetAccessToken() As String
' input hardening and better diagnostics
Dim tenantId = If(_tenantId, String.Empty).Trim()
Dim clientId = If(_clientId, String.Empty).Trim()
Dim clientSecret = If(_clientSecret, String.Empty).Trim()
Public Function GetAccessToken() As String
Logger.Debug("Fetching Access Token..")
If String.IsNullOrWhiteSpace(tenantId) Then
Logger.Error("OAuth2: tenantId is empty.")
Throw New ArgumentException("tenantId is empty")
End If
If String.IsNullOrWhiteSpace(clientId) Then
Logger.Error("OAuth2: clientId is empty.")
Throw New ArgumentException("clientId is empty")
End If
If String.IsNullOrWhiteSpace(clientSecret) Then
Logger.Error("OAuth2: clientSecret is empty.")
Throw New ArgumentException("clientSecret is empty")
End If
Try
' Create the application, which is defined in
' Microsoft.Identity.Client
Dim oApp = ConfidentialClientApplicationBuilder.
Create(ClientId).
WithTenantId(TenantId).
WithClientSecret(ClientSecret).
Build()
' common misconfiguration: using the Secret ID (GUID) instead of the Secret VALUE
Dim tmpGuid As Guid
If Guid.TryParse(clientSecret, tmpGuid) Then
Logger.Error("OAuth2: clientSecret looks like a GUID (likely the secret ID). Use the secret VALUE instead.")
Throw New ApplicationException("Invalid client secret: looks like Secret ID (GUID), not the secret value.")
End If
' Request an access token
Dim oScopes = New List(Of String) From {O365_SCOPE}
Dim oResult = oApp.
AcquireTokenForClient(oScopes).
ExecuteAsync().Result
Try
Dim authority = O365_AUTHORITY_PREFIX & tenantId
Logger.Debug("Access Token fetched.")
Dim app = ConfidentialClientApplicationBuilder.Create(clientId).
WithClientSecret(clientSecret).
WithAuthority(authority).
Build()
Return oResult.AccessToken
Catch ex As Exception
Logger.Warn("Could not request access token!")
Logger.Error(ex)
Return Nothing
End Try
End Function
End Class
Dim scopes = New String() {O365_SCOPE}
Dim result = app.AcquireTokenForClient(scopes).ExecuteAsync().GetAwaiter().GetResult()
Logger.Info("OAuth2 token acquired for tenant {0}. ExpiresOn={1:u}", tenantId, result.ExpiresOn.UtcDateTime)
Return result.AccessToken
Catch ex As MsalServiceException
' richer diagnostics without depending on specific MSAL version members
Logger.Error("MSAL service error. Code={0}. Message={1}", ex.ErrorCode, ex.Message)
' Try to log StatusCode, ResponseBody if available (via reflection to avoid version dependency)
Try
Dim t = GetType(MsalServiceException)
Dim scProp = t.GetProperty("StatusCode")
If scProp IsNot Nothing Then
Dim sc = scProp.GetValue(ex, Nothing)
If sc IsNot Nothing Then Logger.Error("MSAL StatusCode={0}", sc)
End If
Dim rbProp = t.GetProperty("ResponseBody")
If rbProp IsNot Nothing Then
Dim rb = rbProp.GetValue(ex, Nothing)
If rb IsNot Nothing Then Logger.Error("MSAL ResponseBody={0}", rb)
End If
Dim ciProp = t.GetProperty("Claims")
If ciProp IsNot Nothing Then
Dim claims = ciProp.GetValue(ex, Nothing)
If claims IsNot Nothing AndAlso claims.ToString().Length > 0 Then Logger.Error("MSAL Claims={0}", claims)
End If
Catch
' ignore reflection diagnostics failures
End Try
Throw
Catch ex As Exception
Logger.Error(ex)
Throw
End Try
End Function
End Class
End Namespace

8
Messaging/Messaging.vbproj
View File

@@ -1,4 +1,4 @@
<?xml version="1.0" encoding="utf-8"?>
<?xml version="1.0" encoding="utf-8"?>
<Project ToolsVersion="15.0" xmlns="http://schemas.microsoft.com/developer/msbuild/2003">
<Import Project="$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props" Condition="Exists('$(MSBuildExtensionsPath)\$(MSBuildToolsVersion)\Microsoft.Common.props')" />
<PropertyGroup>
@@ -47,9 +47,9 @@
<Reference Include="DigitalData.Modules.Logging, Version=2.6.5.0, Culture=neutral, processorArchitecture=MSIL">
<HintPath>..\packages\DigitalData.Modules.Logging.2.6.5\lib\net462\DigitalData.Modules.Logging.dll</HintPath>
</Reference>
<Reference Include="Mail">
<HintPath>P:\Visual Studio Projekte\Bibliotheken\Limilabs\Mail.dll\Mail.dll</HintPath>
<EmbedInteropTypes>False</EmbedInteropTypes>
<Reference Include="Mail, Version=3.0.25239.1527, Culture=neutral, PublicKeyToken=6dc438ab78a525b3, processorArchitecture=MSIL">
<SpecificVersion>False</SpecificVersion>
<HintPath>P:\Projekte DIGITAL DATA\DIGITAL DATA - Entwicklung\DLL_Bibliotheken\Limilabs\Mail.dll</HintPath>
</Reference>
<Reference Include="Microsoft.CSharp" />
<Reference Include="Microsoft.Identity.Client, Version=4.55.0.0, Culture=neutral, PublicKeyToken=0a613f4dd989e8ae, processorArchitecture=MSIL">

4
Messaging/My Project/AssemblyInfo.vb
View File

@@ -31,5 +31,5 @@ Imports System.Runtime.InteropServices
' übernehmen, indem Sie "*" eingeben:
' <Assembly: AssemblyVersion("1.0.*")>
<Assembly: AssemblyVersion("1.9.8.0")>
<Assembly: AssemblyFileVersion("1.9.8.0")>
<Assembly: AssemblyVersion("2.0.0.0")>
<Assembly: AssemblyFileVersion("2.0.0.0")>