Added auto update feature
This commit is contained in:
@@ -0,0 +1,502 @@
|
||||
Imports System.Collections.Generic
|
||||
Imports System.IO
|
||||
Imports System.Net.Http
|
||||
Imports System.Security.Cryptography
|
||||
Imports System.Web.Script.Serialization
|
||||
Imports System.Windows.Forms
|
||||
|
||||
' ---------------------------------------------------------------------------
|
||||
' Updater.vb - self-update for Shipping Tracker
|
||||
'
|
||||
' Requires a project reference to: System.Web.Extensions (for JavaScriptSerializer)
|
||||
' Everything else is in the framework already.
|
||||
'
|
||||
' Wire-up (see notes at bottom of file):
|
||||
' Form1_Load -> Updater.CleanupOldBinary() + Await Updater.CheckForUpdatesAsync(True)
|
||||
' Form3 btnUpdates -> Await Updater.CheckForUpdatesAsync(False)
|
||||
' ---------------------------------------------------------------------------
|
||||
|
||||
Public Module Updater
|
||||
|
||||
' --- configuration -----------------------------------------------------
|
||||
|
||||
Private Const ApiLatest As String =
|
||||
"https://gitea.apointless.space/api/v1/repos/bsncubed/ShippingTracker/releases/latest"
|
||||
|
||||
Private Const ReleasesPage As String =
|
||||
"https://gitea.apointless.space/bsncubed/ShippingTracker/releases"
|
||||
|
||||
' Name of the .exe asset attached to each release. Must match exactly.
|
||||
Private Const AssetName As String = "Shipping Tracker.exe"
|
||||
|
||||
' Name of the checksum asset. sha256sum format: "<hash> <filename>" per line.
|
||||
Private Const ChecksumAssetName As String = "checksums.txt"
|
||||
|
||||
Private ReadOnly Http As New HttpClient() With {.Timeout = TimeSpan.FromSeconds(10)}
|
||||
|
||||
' --- public entry points -----------------------------------------------
|
||||
|
||||
''' <summary>
|
||||
''' Checks for a newer release and offers to install it.
|
||||
''' silent = True -> startup check. Any failure (offline, DNS, timeout,
|
||||
''' bad response) returns quietly with no UI at all.
|
||||
''' silent = False -> user clicked "Check for updates". Reports
|
||||
''' "up to date" and surfaces errors.
|
||||
''' </summary>
|
||||
Public Async Function CheckForUpdatesAsync(silent As Boolean) As Task
|
||||
|
||||
Dim rel As ReleaseInfo = Nothing
|
||||
|
||||
Try
|
||||
rel = Await FetchLatestReleaseAsync()
|
||||
Catch ex As Exception
|
||||
' Offline / DNS failure / timeout / non-200 / malformed JSON.
|
||||
If Not silent Then
|
||||
MessageBox.Show("Could not check for updates:" & vbCrLf & vbCrLf & ex.Message,
|
||||
"Shipping Tracker", MessageBoxButtons.OK, MessageBoxIcon.Warning)
|
||||
End If
|
||||
Return
|
||||
End Try
|
||||
|
||||
If rel Is Nothing OrElse rel.Version Is Nothing Then
|
||||
If Not silent Then
|
||||
MessageBox.Show("Could not read the latest version number.",
|
||||
"Shipping Tracker", MessageBoxButtons.OK, MessageBoxIcon.Warning)
|
||||
End If
|
||||
Return
|
||||
End If
|
||||
|
||||
Dim current As Version = Normalise(My.Application.Info.Version)
|
||||
|
||||
If rel.Version <= current Then
|
||||
If Not silent Then
|
||||
MessageBox.Show("You're running the latest version (" & current.ToString() & ").",
|
||||
"Shipping Tracker", MessageBoxButtons.OK, MessageBoxIcon.Information)
|
||||
End If
|
||||
Return
|
||||
End If
|
||||
|
||||
' --- newer version available ---------------------------------------
|
||||
|
||||
Dim answer = MessageBox.Show(
|
||||
"A new version of Shipping Tracker is available." & vbCrLf & vbCrLf &
|
||||
"You have: " & current.ToString() & vbCrLf &
|
||||
"Available: " & rel.Version.ToString() & vbCrLf & vbCrLf &
|
||||
"Update now?",
|
||||
"Update available", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
|
||||
|
||||
If answer <> DialogResult.Yes Then Return
|
||||
|
||||
If String.IsNullOrEmpty(rel.AssetUrl) Then
|
||||
OfferManualDownload("This release doesn't contain a file named """ & AssetName & """.")
|
||||
Return
|
||||
End If
|
||||
|
||||
' Fail early if we can't write next to ourselves (e.g. Program Files,
|
||||
' read-only network share) rather than half-applying the update.
|
||||
If Not CanWriteBesideExe() Then
|
||||
OfferManualDownload("Shipping Tracker doesn't have permission to update itself " &
|
||||
"in this folder.")
|
||||
Return
|
||||
End If
|
||||
|
||||
Await DownloadAndApplyAsync(rel)
|
||||
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' Deletes the previous binary left behind by an update.
|
||||
''' Call once, early, from Form1_Load. Never throws.
|
||||
''' </summary>
|
||||
Public Sub CleanupOldBinary()
|
||||
Try
|
||||
Dim oldPath = Application.ExecutablePath & ".old"
|
||||
If File.Exists(oldPath) Then File.Delete(oldPath)
|
||||
Catch
|
||||
' Still locked, or already gone. Harmless - try again next launch.
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
' --- release metadata --------------------------------------------------
|
||||
|
||||
Private Class ReleaseInfo
|
||||
Public Property Version As Version
|
||||
Public Property AssetUrl As String
|
||||
Public Property ChecksumUrl As String
|
||||
End Class
|
||||
|
||||
Private Async Function FetchLatestReleaseAsync() As Task(Of ReleaseInfo)
|
||||
|
||||
Using req As New HttpRequestMessage(HttpMethod.Get, ApiLatest)
|
||||
req.Headers.Add("User-Agent", "ShippingTracker")
|
||||
req.Headers.Add("Accept", "application/json")
|
||||
|
||||
Using resp = Await Http.SendAsync(req)
|
||||
resp.EnsureSuccessStatusCode()
|
||||
Dim body = Await resp.Content.ReadAsStringAsync()
|
||||
|
||||
Dim js As New JavaScriptSerializer()
|
||||
Dim root = TryCast(js.DeserializeObject(body), Dictionary(Of String, Object))
|
||||
If root Is Nothing Then Return Nothing
|
||||
|
||||
Dim info As New ReleaseInfo()
|
||||
|
||||
Dim tag As String = Nothing
|
||||
If root.ContainsKey("tag_name") Then tag = TryCast(root("tag_name"), String)
|
||||
info.Version = ParseVersion(tag)
|
||||
|
||||
If root.ContainsKey("assets") Then
|
||||
Dim assets = TryCast(root("assets"), Object())
|
||||
If assets IsNot Nothing Then
|
||||
For Each a In assets
|
||||
Dim asset = TryCast(a, Dictionary(Of String, Object))
|
||||
If asset Is Nothing Then Continue For
|
||||
|
||||
Dim name As String = Nothing
|
||||
Dim url As String = Nothing
|
||||
If asset.ContainsKey("name") Then name = TryCast(asset("name"), String)
|
||||
If asset.ContainsKey("browser_download_url") Then _
|
||||
url = TryCast(asset("browser_download_url"), String)
|
||||
|
||||
If name Is Nothing OrElse url Is Nothing Then Continue For
|
||||
|
||||
If String.Equals(name, AssetName, StringComparison.OrdinalIgnoreCase) Then
|
||||
info.AssetUrl = url
|
||||
ElseIf String.Equals(name, ChecksumAssetName, StringComparison.OrdinalIgnoreCase) Then
|
||||
info.ChecksumUrl = url
|
||||
End If
|
||||
Next
|
||||
End If
|
||||
End If
|
||||
|
||||
Return info
|
||||
End Using
|
||||
End Using
|
||||
|
||||
End Function
|
||||
|
||||
' --- version handling --------------------------------------------------
|
||||
|
||||
''' <summary>
|
||||
''' Parses a tag like "1.2.0.0", "v1.2.0" or "1.2" into a 4-part Version.
|
||||
''' Missing components become 0 so comparison against AssemblyVersion is sane
|
||||
''' (an unset component in System.Version is -1, which would sort wrong).
|
||||
''' </summary>
|
||||
Private Function ParseVersion(tag As String) As Version
|
||||
If String.IsNullOrEmpty(tag) Then Return Nothing
|
||||
|
||||
Dim s = tag.Trim()
|
||||
If s.StartsWith("v", StringComparison.OrdinalIgnoreCase) Then s = s.Substring(1)
|
||||
|
||||
Dim nums As New List(Of Integer)
|
||||
For Each part In s.Split("."c)
|
||||
Dim n As Integer
|
||||
If Not Integer.TryParse(part.Trim(), n) Then Exit For
|
||||
If n < 0 Then Exit For
|
||||
nums.Add(n)
|
||||
If nums.Count = 4 Then Exit For
|
||||
Next
|
||||
|
||||
If nums.Count = 0 Then Return Nothing
|
||||
While nums.Count < 4
|
||||
nums.Add(0)
|
||||
End While
|
||||
|
||||
Return New Version(nums(0), nums(1), nums(2), nums(3))
|
||||
End Function
|
||||
|
||||
Private Function Normalise(v As Version) As Version
|
||||
Return New Version(Math.Max(v.Major, 0), Math.Max(v.Minor, 0),
|
||||
Math.Max(v.Build, 0), Math.Max(v.Revision, 0))
|
||||
End Function
|
||||
|
||||
' --- download / verify / swap -----------------------------------------
|
||||
|
||||
Private Async Function DownloadAndApplyAsync(rel As ReleaseInfo) As Task
|
||||
|
||||
Dim exePath = Application.ExecutablePath
|
||||
Dim newPath = exePath & ".new"
|
||||
|
||||
Dim prog As New UpdateProgressForm()
|
||||
prog.Show()
|
||||
|
||||
Try
|
||||
' 1. download the new binary
|
||||
prog.SetStatus("Downloading update...")
|
||||
Await DownloadToFileAsync(rel.AssetUrl, newPath, prog)
|
||||
|
||||
' 2. verify it, if the release published checksums
|
||||
If Not String.IsNullOrEmpty(rel.ChecksumUrl) Then
|
||||
prog.SetStatus("Verifying download...")
|
||||
prog.SetProgress(100)
|
||||
|
||||
Dim expected = Await FetchExpectedHashAsync(rel.ChecksumUrl)
|
||||
If String.IsNullOrEmpty(expected) Then
|
||||
Throw New Exception("The checksum file has no entry for """ & AssetName & """.")
|
||||
End If
|
||||
|
||||
Dim actual = Sha256File(newPath)
|
||||
If Not String.Equals(expected, actual, StringComparison.OrdinalIgnoreCase) Then
|
||||
Throw New Exception("Checksum mismatch - the download was corrupted or tampered with." &
|
||||
vbCrLf & vbCrLf &
|
||||
"Expected: " & expected & vbCrLf &
|
||||
"Got: " & actual)
|
||||
End If
|
||||
End If
|
||||
|
||||
' 3. swap the binaries
|
||||
prog.SetStatus("Installing...")
|
||||
ApplyUpdate(newPath)
|
||||
|
||||
Catch ex As Exception
|
||||
SafeDelete(newPath)
|
||||
prog.Close()
|
||||
OfferManualDownload("The update could not be installed:" & vbCrLf & vbCrLf & ex.Message)
|
||||
Return
|
||||
End Try
|
||||
|
||||
prog.Close()
|
||||
|
||||
MessageBox.Show("Update installed. Shipping Tracker will now restart.",
|
||||
"Shipping Tracker", MessageBoxButtons.OK, MessageBoxIcon.Information)
|
||||
|
||||
Try
|
||||
Process.Start(exePath)
|
||||
Catch
|
||||
' If relaunch fails the update is still applied - next manual
|
||||
' launch gets the new version.
|
||||
End Try
|
||||
|
||||
Application.Exit()
|
||||
|
||||
End Function
|
||||
|
||||
Private Async Function DownloadToFileAsync(url As String, destPath As String,
|
||||
prog As UpdateProgressForm) As Task
|
||||
|
||||
Using req As New HttpRequestMessage(HttpMethod.Get, url)
|
||||
req.Headers.Add("User-Agent", "ShippingTracker")
|
||||
|
||||
' ResponseHeadersRead so we stream to disk instead of buffering it all.
|
||||
Using resp = Await Http.SendAsync(req, HttpCompletionOption.ResponseHeadersRead)
|
||||
resp.EnsureSuccessStatusCode()
|
||||
|
||||
Dim total As Long = -1
|
||||
If resp.Content.Headers.ContentLength.HasValue Then
|
||||
total = resp.Content.Headers.ContentLength.Value
|
||||
End If
|
||||
|
||||
Using src = Await resp.Content.ReadAsStreamAsync(),
|
||||
dst = New FileStream(destPath, FileMode.Create, FileAccess.Write, FileShare.None)
|
||||
|
||||
Dim buffer(81919) As Byte
|
||||
Dim readTotal As Long = 0
|
||||
Dim n As Integer
|
||||
|
||||
Do
|
||||
n = Await src.ReadAsync(buffer, 0, buffer.Length)
|
||||
If n = 0 Then Exit Do
|
||||
Await dst.WriteAsync(buffer, 0, n)
|
||||
readTotal += n
|
||||
If total > 0 Then
|
||||
prog.SetProgress(CInt(Math.Min(100L, readTotal * 100L \ total)))
|
||||
End If
|
||||
Loop
|
||||
End Using
|
||||
End Using
|
||||
End Using
|
||||
|
||||
End Function
|
||||
|
||||
Private Async Function FetchExpectedHashAsync(checksumUrl As String) As Task(Of String)
|
||||
|
||||
Using req As New HttpRequestMessage(HttpMethod.Get, checksumUrl)
|
||||
req.Headers.Add("User-Agent", "ShippingTracker")
|
||||
|
||||
Using resp = Await Http.SendAsync(req)
|
||||
resp.EnsureSuccessStatusCode()
|
||||
Dim text = Await resp.Content.ReadAsStringAsync()
|
||||
|
||||
' sha256sum format: "<hash> <filename>" (two spaces, or " *")
|
||||
For Each line In text.Split({vbCr, vbLf}, StringSplitOptions.RemoveEmptyEntries)
|
||||
Dim trimmed = line.Trim()
|
||||
If trimmed.Length = 0 Then Continue For
|
||||
|
||||
Dim sep = trimmed.IndexOf(" "c)
|
||||
If sep <= 0 Then Continue For
|
||||
|
||||
Dim hash = trimmed.Substring(0, sep).Trim()
|
||||
Dim name = trimmed.Substring(sep).Trim().TrimStart("*"c).Trim()
|
||||
|
||||
If String.Equals(name, AssetName, StringComparison.OrdinalIgnoreCase) Then
|
||||
Return hash
|
||||
End If
|
||||
Next
|
||||
|
||||
Return Nothing
|
||||
End Using
|
||||
End Using
|
||||
|
||||
End Function
|
||||
|
||||
Private Function Sha256File(path As String) As String
|
||||
Using sha = SHA256.Create(), fs = File.OpenRead(path)
|
||||
Return BitConverter.ToString(sha.ComputeHash(fs)).Replace("-", "").ToLowerInvariant()
|
||||
End Using
|
||||
End Function
|
||||
|
||||
''' <summary>
|
||||
''' Windows won't let you delete a running .exe, but it will let you RENAME
|
||||
''' one. So: current -> .old, downloaded -> current. The .old file is removed
|
||||
''' by CleanupOldBinary() on the next launch.
|
||||
''' </summary>
|
||||
Private Sub ApplyUpdate(newFile As String)
|
||||
|
||||
Dim exePath = Application.ExecutablePath
|
||||
Dim oldPath = exePath & ".old"
|
||||
|
||||
SafeDelete(oldPath)
|
||||
|
||||
File.Move(exePath, oldPath) ' running exe is now .old
|
||||
|
||||
Try
|
||||
File.Move(newFile, exePath) ' new binary takes its place
|
||||
Catch
|
||||
' Roll back so the user isn't left without an application.
|
||||
Try
|
||||
File.Move(oldPath, exePath)
|
||||
Catch
|
||||
End Try
|
||||
Throw
|
||||
End Try
|
||||
|
||||
End Sub
|
||||
|
||||
' --- helpers -----------------------------------------------------------
|
||||
|
||||
Private Function CanWriteBesideExe() As Boolean
|
||||
Try
|
||||
Dim dir = Path.GetDirectoryName(Application.ExecutablePath)
|
||||
Dim probe = Path.Combine(dir, "." & Guid.NewGuid().ToString("N") & ".tmp")
|
||||
Using fs = New FileStream(probe, FileMode.CreateNew, FileAccess.Write, FileShare.None)
|
||||
End Using
|
||||
File.Delete(probe)
|
||||
Return True
|
||||
Catch
|
||||
Return False
|
||||
End Try
|
||||
End Function
|
||||
|
||||
Private Sub SafeDelete(path As String)
|
||||
Try
|
||||
If File.Exists(path) Then File.Delete(path)
|
||||
Catch
|
||||
End Try
|
||||
End Sub
|
||||
|
||||
Private Sub OfferManualDownload(message As String)
|
||||
Dim answer = MessageBox.Show(
|
||||
message & vbCrLf & vbCrLf & "Open the downloads page instead?",
|
||||
"Shipping Tracker", MessageBoxButtons.YesNo, MessageBoxIcon.Warning)
|
||||
|
||||
If answer = DialogResult.Yes Then
|
||||
Try
|
||||
Process.Start(ReleasesPage)
|
||||
Catch
|
||||
End Try
|
||||
End If
|
||||
End Sub
|
||||
|
||||
End Module
|
||||
|
||||
|
||||
''' <summary>
|
||||
''' Minimal progress window, built in code so there's no extra .Designer.vb
|
||||
''' to add to the project.
|
||||
''' </summary>
|
||||
Friend Class UpdateProgressForm
|
||||
Inherits Form
|
||||
|
||||
Private ReadOnly _bar As ProgressBar
|
||||
Private ReadOnly _label As Label
|
||||
|
||||
Public Sub New()
|
||||
Me.Text = "Updating Shipping Tracker"
|
||||
Me.FormBorderStyle = FormBorderStyle.FixedDialog
|
||||
Me.StartPosition = FormStartPosition.CenterScreen
|
||||
Me.MaximizeBox = False
|
||||
Me.MinimizeBox = False
|
||||
Me.ControlBox = False
|
||||
Me.ClientSize = New Drawing.Size(360, 90)
|
||||
|
||||
_label = New Label() With {
|
||||
.Text = "Starting...",
|
||||
.AutoSize = False,
|
||||
.Location = New Drawing.Point(15, 15),
|
||||
.Size = New Drawing.Size(330, 20)
|
||||
}
|
||||
|
||||
_bar = New ProgressBar() With {
|
||||
.Location = New Drawing.Point(15, 45),
|
||||
.Size = New Drawing.Size(330, 22),
|
||||
.Minimum = 0,
|
||||
.Maximum = 100
|
||||
}
|
||||
|
||||
Me.Controls.Add(_label)
|
||||
Me.Controls.Add(_bar)
|
||||
End Sub
|
||||
|
||||
Public Sub SetStatus(text As String)
|
||||
_label.Text = text
|
||||
_label.Refresh()
|
||||
End Sub
|
||||
|
||||
Public Sub SetProgress(percent As Integer)
|
||||
If percent < 0 Then percent = 0
|
||||
If percent > 100 Then percent = 100
|
||||
_bar.Value = percent
|
||||
End Sub
|
||||
|
||||
End Class
|
||||
|
||||
|
||||
' ---------------------------------------------------------------------------
|
||||
' INTEGRATION
|
||||
'
|
||||
' 1. Project -> Add Reference -> Assemblies -> System.Web.Extensions
|
||||
'
|
||||
' 2. Form1.vb - replace the existing Form1_Load with:
|
||||
'
|
||||
' Private Async Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load
|
||||
' lblCoppiedNotifyer.Text = ""
|
||||
' Updater.CleanupOldBinary()
|
||||
' Await Updater.CheckForUpdatesAsync(True)
|
||||
' End Sub
|
||||
'
|
||||
' (Async Sub is fine here - the await resumes on the UI thread, and the
|
||||
' window paints while the HTTP request is in flight.)
|
||||
'
|
||||
' 3. Form3.vb - replace the btnUpdates handler with:
|
||||
'
|
||||
' Private Async Sub Button1_Click(sender As Object, e As EventArgs) Handles btnUpdates.Click
|
||||
' Await Updater.CheckForUpdatesAsync(False)
|
||||
' End Sub
|
||||
'
|
||||
' 4. Bump <Assembly: AssemblyVersion> and AssemblyFileVersion in
|
||||
' My Project\AssemblyInfo.vb before each release. This is what the updater
|
||||
' compares against - if you forget, users are told they're up to date.
|
||||
'
|
||||
' PUBLISHING A RELEASE
|
||||
'
|
||||
' - Tag the release "1.2.0.0" (a leading "v" is also accepted).
|
||||
' - Attach the built binary, named exactly: Shipping Tracker.exe
|
||||
' - Attach checksums.txt containing:
|
||||
' <sha256> Shipping Tracker.exe
|
||||
' Generate it in PowerShell with:
|
||||
' (Get-FileHash ".\Shipping Tracker.exe" -Algorithm SHA256).Hash.ToLower() `
|
||||
' + " Shipping Tracker.exe" | Out-File checksums.txt -Encoding ascii
|
||||
' - Don't mark it pre-release: /releases/latest skips drafts and pre-releases.
|
||||
'
|
||||
' If checksums.txt is missing the update still installs, but unverified.
|
||||
' ---------------------------------------------------------------------------
|
||||
Reference in New Issue
Block a user