use new system via an update info

This commit is contained in:
2023-05-04 11:12:21 +02:00
parent 6dd6721667
commit 0d7e570676
9 changed files with 209 additions and 22 deletions

View File

@@ -8,6 +8,7 @@ Public Class Form1
Private updateConfig As New UpdateConfig
Private currentUpdating As Boolean = False
Private lastUpdateCheckResult As UpdateCheckResult = Nothing
Public Sub New()
InitializeComponent()
@@ -75,42 +76,43 @@ Public Class Form1
End If
End Sub
Private Async Function ExecuteUpdate(allowInstall As Boolean) As Task
SetStatus(LangRes.StatusText_CheckingForUpdates, MySymbols.icons8_update_16px)
Private Async Function ExecuteUpdate(doInstall As Boolean) As Task
Dim updater As New UpdateInstaller(updateConfig, GetMinecraftProfilePath)
AddHandler updater.InstallProgessUpdated, AddressOf Update_InstallProgessUpdated
AddHandler updater.CheckingProgressUpdated, AddressOf Updated_CheckingProgresssUpdated
Dim result As UpdateCheckResult = Await updater.CheckForUpdates(Not AppConfig.Instance.AllowRemoveLocalFiles)
Dim everytingOk As Boolean = False
'Check only if not pressed "install", not really needed otherwise.
If lastUpdateCheckResult Is Nothing OrElse Not doInstall Then
SetStatus(LangRes.StatusText_CheckingForUpdates, MySymbols.icons8_update_16px)
lastUpdateCheckResult = Await updater.CheckForUpdates(Not AppConfig.Instance.AllowRemoveLocalFiles)
End If
If result Is Nothing Then
If lastUpdateCheckResult Is Nothing OrElse lastUpdateCheckResult.HasError Then
SetStatus(LangRes.StatusText_ErrorWhileUpdateCheckOrUpdate, MySymbols.icons8_delete_16px)
ElseIf result.HasUpdates Then
SetStatus(LangRes.StatusText_UpdateAvailable, MySymbols.icons8_software_installer_16px)
If allowInstall Then
currentUpdating = True
ElseIf lastUpdateCheckResult.HasUpdates Then
If doInstall Then
SetStatus(LangRes.StatusText_Installing, MySymbols.icons8_software_installer_16px)
currentUpdating = True
If Await updater.InstallUpdates(result) Then
everytingOk = True
If Await updater.InstallUpdates(lastUpdateCheckResult) Then
lastUpdateCheckResult = Nothing 'Reset last update check, a new one would be needed now.
SetStatus(LangRes.StatusTest_EverythingOk, MySymbols.icons8_checkmark_16px)
Else
SetStatus(LangRes.StatusText_ErrorWhileUpdateCheckOrUpdate, MySymbols.icons8_delete_16px)
End If
currentUpdating = False
Else
SetStatus(LangRes.StatusText_UpdateAvailable, MySymbols.icons8_software_installer_16px)
End If
Else
everytingOk = True
End If
If everytingOk Then
SetStatus(LangRes.StatusTest_EverythingOk, MySymbols.icons8_checkmark_16px)
End If
End Function
Private Sub Update_InstallProgessUpdated(result As UpdateCheckResult, processedSyncs As Integer)
SetStatus(Math.Round(processedSyncs / result.SyncFiles.Count * 100, 1) & "%", MySymbols.icons8_software_installer_16px)
Dim actionCount = If(result.IsLegacy, result.SyncFiles.Count, result.UpdateActions.Count)
SetStatus(Math.Round(processedSyncs / actionCount * 100, 1) & "%", MySymbols.icons8_software_installer_16px)
End Sub
Private Sub Updated_CheckingProgresssUpdated(toCheck As Integer, processed As Integer)

View File

@@ -0,0 +1,30 @@
Imports System.IO
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Converters
Imports Newtonsoft.Json.Linq
Public Class ModpackInfo
Private Const FILENAME_MODPACKINFO = "modpack-info.json"
<JsonConverter(GetType(VersionConverter))>
Public Property Version As Version
Public Sub Save(mcRoot As String)
File.WriteAllText(GetFilePath(mcRoot), JObject.FromObject(Me).ToString)
End Sub
Public Shared Function Load(mcRoot As String) As ModpackInfo
Return JObject.Parse(File.ReadAllText(GetFilePath(mcRoot))).ToObject(Of ModpackInfo)
End Function
Public Shared Function HasModpackInfo(mcRoot As String) As Boolean
Return File.Exists(GetFilePath(mcRoot))
End Function
Private Shared Function GetFilePath(mcRoot As String)
Return Path.Combine(mcRoot, FILENAME_MODPACKINFO)
End Function
End Class

View File

@@ -0,0 +1,12 @@
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Converters
Public Class UpdateAction
<JsonConverter(GetType(StringEnumConverter))>
Public Property Type As UpdateActionType
Public Property DestPath As String
Public Property SrcPath As String
Public Property DownloadUrl As String
End Class

View File

@@ -0,0 +1,7 @@
Public Enum UpdateActionType
None
Update
Delete
Move
Copy
End Enum

View File

@@ -1,10 +1,20 @@
Public Class UpdateCheckResult
Public Property IsLegacy As Boolean
Public ReadOnly Property SyncFiles As New List(Of UpdateSyncFile)
Public Property CurrentVersion As Version
Public Property LatestVersion As Version
Public ReadOnly Property UpdateActions As New List(Of UpdateAction)
Public Property HasError As Boolean
Public ReadOnly Property HasUpdates As Boolean
Get
Return SyncFiles.Where(Function(n) n.SyncAction <> UpdateSyncAction.None).Any
If IsLegacy Then
Return SyncFiles.Where(Function(n) n.SyncAction <> UpdateSyncAction.None).Any
Else
Return CurrentVersion < LatestVersion
End If
End Get
End Property

View File

@@ -6,6 +6,7 @@ Imports Pilz.Cryptography
Public Class UpdateConfig
Public Property UpdateUrl As String
Public Property WebdavURL As SecureString
Public Property WebdavUsername As SecureString
Public Property WebdavPassword As SecureString
@@ -14,7 +15,7 @@ Public Class UpdateConfig
File.WriteAllText(filePath, JObject.FromObject(Me).ToString)
End Sub
Public Shared Function LoadFromFile(filePath As string)
Public Shared Function LoadFromFile(filePath As String) As UpdateConfig
Return JObject.Parse(File.ReadAllText(filePath)).ToObject(Of UpdateConfig)
End Function

View File

@@ -0,0 +1,10 @@
Imports Newtonsoft.Json
Imports Newtonsoft.Json.Converters
Public Class UpdateInfo
<JsonConverter(GetType(VersionConverter))>
Public Property Version As Version
Public ReadOnly Property Actions As New List(Of UpdateAction)
End Class

View File

@@ -0,0 +1,11 @@
Imports Newtonsoft.Json.Linq
Public Class UpdateInfos
Public ReadOnly Property Updates As New List(Of UpdateInfo)
Public Shared Function Parse(content As String) As UpdateInfos
Return JObject.Parse(content).ToObject(Of UpdateInfos)
End Function
End Class

View File

@@ -1,5 +1,6 @@
Imports System.IO
Imports System.Net
Imports System.Net.Http
Imports WebDav
@@ -11,12 +12,18 @@ Public Class UpdateInstaller
Private ReadOnly updateConfig As UpdateConfig
Private ReadOnly localPath As String
Private webdavClient As WebDavClient = Nothing
Private httpClient As New HttpClient
Public Sub New(updateConfig As UpdateConfig, localPath As String)
Me.updateConfig = updateConfig
Me.localPath = localPath
End Sub
Protected Overrides Sub Finalize()
httpClient.Dispose()
MyBase.Finalize()
End Sub
Private Function CreateClient() As WebDavClient
If webdavClient Is Nothing Then
Dim params As New WebDavClientParams With {
@@ -29,13 +36,57 @@ Public Class UpdateInstaller
Return webdavClient
End Function
Private Async Function DownloadUpdateInfos() As Task(Of UpdateInfos)
Dim content As String = Await httpClient.GetStringAsync(updateConfig.UpdateUrl)
Return UpdateInfos.Parse(content)
End Function
Public Async Function CheckForUpdates(ignoreRevmoedFiles As Boolean) As Task(Of UpdateCheckResult)
Dim infos As UpdateInfos = Await DownloadUpdateInfos()
Dim result As New UpdateCheckResult
If infos IsNot Nothing AndAlso infos.Updates.Any Then
Dim updatesOrderes = infos.Updates.OrderByDescending(Function(n) n.Version)
result.LatestVersion = updatesOrderes.First.Version
If ModpackInfo.HasModpackInfo(localPath) Then
Dim modpackInfo As ModpackInfo = ModpackInfo.Load(localPath)
result.CurrentVersion = modpackInfo.Version
Dim checkingVersionIndex As Integer = 0
Dim checkingVersion As UpdateInfo = updatesOrderes(checkingVersionIndex)
Do While checkingVersion IsNot Nothing AndAlso checkingVersion.Version > result.CurrentVersion
Dim actionsToAdd As New List(Of UpdateAction)
For Each action In checkingVersion.Actions
If Not result.UpdateActions.Any(Function(n) n.DestPath = action.DestPath) Then
actionsToAdd.Add(action)
End If
Next
result.UpdateActions.InsertRange(0, actionsToAdd)
checkingVersionIndex += 1
checkingVersion = updatesOrderes.ElementAtOrDefault(checkingVersionIndex)
Loop
Else
Await CheckForUpdatesLegacy(result, ignoreRevmoedFiles)
End If
End If
Return result
End Function
Private Async Function CheckForUpdatesLegacy(result As UpdateCheckResult, ignoreRevmoedFiles As Boolean) As Task
Dim client As WebDavClient = CreateClient()
Dim resTopFolder As WebDavResource = Nothing
Dim checkedFiles = New List(Of String)()
Dim responseSuccessfull As Boolean = False
result.CurrentVersion = New Version("0.0.0.0")
result.IsLegacy = True
'Check for new & updated files
Dim response = Await client.Propfind(String.Empty, New PropfindParameters() With {.ApplyTo = ApplyTo.Propfind.ResourceAndAncestors})
If resTopFolder Is Nothing AndAlso response.IsSuccessful AndAlso response.Resources.Any() Then
@@ -101,11 +152,64 @@ Public Class UpdateInstaller
End If
Next
End If
Return result
End Function
Public Async Function InstallUpdates(checkResult As UpdateCheckResult, Optional ignoreActions As UpdateSyncAction = UpdateSyncAction.None) As Task(Of Boolean?)
Dim isSuccessfully As Boolean
Dim modpackInfo As ModpackInfo
If ModpackInfo.HasModpackInfo(localPath) Then
modpackInfo = ModpackInfo.Load(localPath)
Else
modpackInfo = New ModpackInfo
End If
If checkResult.IsLegacy Then
isSuccessfully = Await InstallUpdatesLegacy(checkResult, ignoreActions)
Else
Dim processed As Integer = 0
For Each action As UpdateAction In checkResult.UpdateActions
Dim destFilePath As String = Path.Combine(localPath, action.DestPath)
Select Case action.Type
Case UpdateActionType.Update
Dim sRemote As Stream = Await httpClient.GetStreamAsync(action.DownloadUrl)
Dim fs As New FileStream(destFilePath, FileMode.Create, FileAccess.ReadWrite)
Await sRemote.CopyToAsync(fs)
sRemote.Close()
fs.Close()
Case UpdateActionType.Delete
If File.Exists(destFilePath) Then
File.Delete(destFilePath)
End If
Case UpdateActionType.Copy
Dim srcFilePath As String = Path.Combine(localPath, action.SrcPath)
If File.Exists(srcFilePath) Then
File.Copy(srcFilePath, destFilePath, True)
End If
Case UpdateActionType.Move
Dim srcFilePath As String = Path.Combine(localPath, action.SrcPath)
If File.Exists(srcFilePath) Then
File.Move(srcFilePath, destFilePath, True)
End If
End Select
processed += 1
RaiseEvent InstallProgessUpdated(checkResult, processed)
Next
isSuccessfully = True
End If
If isSuccessfully Then
modpackInfo.Version = checkResult.LatestVersion
modpackInfo.Save(localPath)
End If
Return isSuccessfully
End Function
Private Async Function InstallUpdatesLegacy(checkResult As UpdateCheckResult, Optional ignoreActions As UpdateSyncAction = UpdateSyncAction.None) As Task(Of Boolean?)
Dim client As WebDavClient = CreateClient()
Dim success As Boolean? = False
Dim processed As Integer = 0