PCL-Communist/Plain Craft Launcher 2/Modules/RedPolicy.vb

'仅保留下载（包括下载所需的版本/依赖元数据）与微软正版登录。
Public Module RedPolicy
    Public Const DefaultTheme As Integer = 15

    Private ReadOnly MetadataHosts As New HashSet(Of String)(StringComparer.OrdinalIgnoreCase) From {
        "launchermeta.mojang.com", "piston-meta.mojang.com", "launcher.mojang.com",
        "bmclapi2.bangbang93.com", "optifine.net", "files.minecraftforge.net",
        "maven.minecraftforge.net", "maven.neoforged.net", "meta.fabricmc.net",
        "dl.liteloader.com", "jenkins.liteloader.com", "api.modrinth.com",
        "api.curseforge.com", "mod.mcimirror.top", "files.mcimirror.top"
    }

    Public Function IsNetworkAllowed(Url As String, Method As HttpMethod, Optional IsFileDownload As Boolean = False) As Boolean
        Dim Address As Uri = Nothing
        If Not Uri.TryCreate(Url.Replace("{CDN}", ""), UriKind.Absolute, Address) Then Return False
        If Address.Scheme <> Uri.UriSchemeHttps AndAlso Address.Scheme <> Uri.UriSchemeHttp Then Return False
        Dim Host = Address.IdnHost
        Dim RequestMethod = If(Method, HttpMethod.Get).Method.ToUpperInvariant()
        Dim ReadOnlyRequest = RequestMethod = "GET" OrElse RequestMethod = "HEAD"
        '即使被当作文件下载，也不允许访问旧的公告、更新、遥测服务。
        If Host = "pcl2-server-1253424809.file.myqcloud.com" OrElse
           Host.EndsWith(".cls.tencentcs.com", StringComparison.OrdinalIgnoreCase) OrElse
           Host = "cls.tencentcs.com" Then Return False
        If IsFileDownload Then Return ReadOnlyRequest
        If Address.Scheme <> Uri.UriSchemeHttps Then Return False

        Select Case Host.ToLowerInvariant()
            Case "login.microsoftonline.com"
                Return RequestMethod = "POST" AndAlso
                    (Address.AbsolutePath = "/consumers/oauth2/v2.0/devicecode" OrElse Address.AbsolutePath = "/consumers/oauth2/v2.0/token")
            Case "login.live.com"
                Return RequestMethod = "POST" AndAlso Address.AbsolutePath = "/oauth20_token.srf"
            Case "user.auth.xboxlive.com"
                Return RequestMethod = "POST" AndAlso Address.AbsolutePath = "/user/authenticate"
            Case "xsts.auth.xboxlive.com"
                Return RequestMethod = "POST" AndAlso Address.AbsolutePath = "/xsts/authorize"
            Case "api.minecraftservices.com"
                Return (RequestMethod = "POST" AndAlso Address.AbsolutePath = "/authentication/login_with_xbox") OrElse
                    (ReadOnlyRequest AndAlso (Address.AbsolutePath = "/entitlements/mcstore" OrElse Address.AbsolutePath = "/minecraft/profile"))
        End Select
        If Not MetadataHosts.Contains(Host) Then Return False
        '资源平台使用 POST 批量查询文件哈希、依赖和下载版本。
        Return ReadOnlyRequest OrElse (RequestMethod = "POST" AndAlso
            (Host = "api.modrinth.com" OrElse Host = "api.curseforge.com" OrElse Host = "mod.mcimirror.top"))
    End Function

    Public Sub EnsureNetworkAllowed(Url As String, Method As HttpMethod, Optional IsFileDownload As Boolean = False)
        If Not IsNetworkAllowed(Url, Method, IsFileDownload) Then
            Throw New NotSupportedException("此修改版仅允许下载及微软正版登录，已禁用此联网功能。")
        End If
    End Sub
End Module