diff --git a/HelloWorld/Updater.vb b/HelloWorld/Updater.vb new file mode 100644 index 0000000..87bc3da --- /dev/null +++ b/HelloWorld/Updater.vb @@ -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: " " per line. + Private Const ChecksumAssetName As String = "checksums.txt" + + Private ReadOnly Http As New HttpClient() With {.Timeout = TimeSpan.FromSeconds(10)} + + ' --- public entry points ----------------------------------------------- + + ''' + ''' 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. + ''' + 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 + + ''' + ''' Deletes the previous binary left behind by an update. + ''' Call once, early, from Form1_Load. Never throws. + ''' + 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 -------------------------------------------------- + + ''' + ''' 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). + ''' + 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: " " (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 + + ''' + ''' 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. + ''' + 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 + + +''' +''' Minimal progress window, built in code so there's no extra .Designer.vb +''' to add to the project. +''' +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 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: +' 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. +' --------------------------------------------------------------------------- diff --git a/exe/1.1.0.2/Shipping Tracker.exe b/exe/1.1.0.2/Shipping Tracker.exe new file mode 100644 index 0000000..71deb7b Binary files /dev/null and b/exe/1.1.0.2/Shipping Tracker.exe differ diff --git a/exe/1.1.0.2/checksums.txt b/exe/1.1.0.2/checksums.txt new file mode 100644 index 0000000..e2b00bd --- /dev/null +++ b/exe/1.1.0.2/checksums.txt @@ -0,0 +1 @@ +3b8e4dcfc328e7f3fedf6c8f0adbc8689e7eeb8c5646d5a81212b863dda07e7a Shipping Tracker.exe