App-Ariza.git | resources/templates/ | update-coordinator.raku.j2
use v6.d;
# Generated by App::Ariza. This file is deliberately core-only: it ships in
# the application's private bundle and must not depend on the build tool.
class Ariza::Update::Coordinator {
constant CADENCE = 604800;
constant MAX-STATE-BYTES = 4096;
constant HANDOFF-ENV = 'ARIZA_UPDATE_HANDOFF';
constant NONCE-ENV = 'ARIZA_UPDATE_NONCE';
constant RELAUNCHED-ENV = 'ARIZA_UPDATE_RELAUNCHED';
has Str $.app-name = {{ app_name_q }};
has Str $.app-exec = {{ app_exec_q }};
has Str $.app-display = {{ app_display_q }};
has Str $.app-version = {{ app_version_q }};
has Str $.repo = {{ repo_q }};
has Str $.installer-rel = {{ installer_rel_q }};
has Callable $.clock = -> { now.Int };
has Callable $.transport = -> Str:D $url { self!discover($url) };
has Callable $.prompt = -> Str:D $version { self!prompt-user($version) };
has Callable $.install = -> Str:D $version { self!install-version($version) };
has Callable $.exit = -> Int:D $status { exit $status };
has Callable $.dispatch = -> { self!dispatch-app };
has Callable $.terminal = -> { $*IN.t && $*OUT.t && $*ERR.t };
has Callable $.physical-current = -> IO::Path:D $root {
self!is-managed-current($root)
};
has Hash $.env = %*ENV;
method valid-version(Str:D $version --> Bool:D) {
so $version ~~ /^ <[0..9]>+ '.' <[0..9]>+ '.' <[0..9]>+ $/
}
# Component strings are normalised, not coerced to native Int, so a tag
# larger than the machine word compares correctly and leading zeros remain
# accepted.
method version-cmp(Str:D $left, Str:D $right --> Int:D) {
die 'invalid update version' unless self.valid-version($left)
&& self.valid-version($right);
for $left.split('.') Z $right.split('.') -> ($a, $b) {
my $aa = $a.subst(/^ '0'+ /, '') || '0';
my $bb = $b.subst(/^ '0'+ /, '') || '0';
return 1 if $aa.chars > $bb.chars;
return -1 if $aa.chars < $bb.chars;
return 1 if $aa gt $bb;
return -1 if $aa lt $bb;
}
0
}
method latest-tag(Str:D $url --> Str) {
my $prefix = "https://github.com/{$!repo}/releases/tag/";
return Str unless $url.starts-with($prefix);
my $tag = $url.substr($prefix.chars);
return Str if !$tag.chars
|| $tag.contains('/')
|| $tag.contains('?')
|| $tag.contains('#')
|| $tag.contains('%');
self.valid-version($tag) ?? $tag !! Str
}
method eligible(IO::Path:D $bundle-root, @args --> Bool:D) {
return False unless $!terminal();
return False if @args.first({ $_ eq '--help' || $_ eq '--version' });
return False if $!env<CI>:exists;
return False if ($!env<ARIZA_NO_UPDATE_CHECK> // '') eq '1';
return False if $!env{RELAUNCHED-ENV}:exists;
my $has-handoff = $!env{HANDOFF-ENV}:exists;
my $has-nonce = $!env{NONCE-ENV}:exists;
return False unless $has-handoff && $has-nonce;
my $handoff = $!env{HANDOFF-ENV} // '';
my $nonce = $!env{NONCE-ENV} // '';
return False unless $handoff.chars <= MAX-STATE-BYTES
&& $handoff.IO.is-absolute
&& $nonce ~~ /^ <[0..9a..f]> ** 64 $/;
return False unless $!physical-current($bundle-root);
my $state = self.state-root($bundle-root);
return False if $state.parent.l || $state.l;
True
}
method state-root(IO::Path:D $bundle-root --> IO::Path:D) {
$bundle-root.parent.parent.add('.ariza').add('update-v1')
}
method read-state(IO::Path:D $path, Str:D :$kind! --> Str) {
return Str unless $path.f;
return Str if $path.s > MAX-STATE-BYTES;
my $value = try { $path.slurp(:enc<ascii>).trim };
return Str unless $value.defined && $value.chars;
given $kind {
when 'version' { self.valid-version($value) ?? $value !! Str }
when 'timestamp' { $value ~~ /^ <[0..9]>+ $/ ?? $value !! Str }
default { Str }
}
}
method write-state(IO::Path:D $path, Str:D $value --> Bool:D) {
return False if $value.encode('utf8').bytes > MAX-STATE-BYTES;
my $ok = try {
self!ensure-dir($path.parent);
my $part = $path.parent.add(
$path.basename ~ ".tmp-{$*PID}-{(^1_000_000).pick}");
LEAVE $part.unlink if $part.e;
$part.spurt($value ~ "\n", :enc<ascii>);
$part.rename($path, :createonly(False));
True
};
so $ok
}
method ignored(IO::Path:D $state, Str:D $version --> Bool:D) {
$state.add('ignored').add($version).f
}
method ignore(IO::Path:D $state, Str:D $version --> Bool:D) {
return False unless self.valid-version($version);
self.write-state($state.add('ignored').add($version), $version)
}
method due(IO::Path:D $state, Int:D $now --> Bool:D) {
my $raw = self.read-state($state.add('last-attempt'), :kind<timestamp>);
return True unless $raw.defined;
my $last = try { $raw.Int };
return True unless $last.defined;
return True if $last > $now; # clock rollback resets the cadence
$now - $last >= CADENCE
}
method acquire-lock(IO::Path:D $state --> IO::Handle) {
my $handle = try {
self!ensure-dir($state);
$state.add('lock').open(:a);
};
return IO::Handle unless $handle.defined;
my $locked = try { $handle.lock(:non-blocking) };
unless $locked {
$handle.close;
return IO::Handle;
}
$handle
}
method state-valid(IO::Path:D $state --> Bool:D) {
my $last = $state.add('last-attempt');
return False if $last.e
&& !self.read-state($last, :kind<timestamp>).defined;
my $pending = $state.add('pending-version');
return False if $pending.e
&& !self.read-state($pending, :kind<version>).defined;
my $ignored = $state.add('ignored');
return False if $ignored.e && !$ignored.d;
if $ignored.d {
for $ignored.dir -> $entry {
return False unless $entry.f
&& self.valid-version($entry.basename)
&& self.read-state($entry, :kind<version>).defined
&& self.read-state($entry, :kind<version>) eq $entry.basename;
}
}
True
}
method candidate(IO::Path:D $state, Int:D $now --> Str) {
my $pending = self.read-state($state.add('pending-version'), :kind<version>);
if $pending.defined {
return $pending if self.version-cmp($pending, $!app-version) > 0
&& !self.ignored($state, $pending);
try { $state.add('pending-version').unlink }
}
return Str unless self.due($state, $now);
# The timestamp is committed before the bounded network call. Offline
# launches therefore wait one cadence instead of hammering GitHub.
return Str unless self.write-state($state.add('last-attempt'), ~$now);
my $url = try { $!transport("https://github.com/{$!repo}/releases/latest") };
return Str unless $url.defined && $url ~~ Str;
my $version = self.latest-tag($url);
return Str unless $version.defined;
return Str unless self.version-cmp($version, $!app-version) > 0;
return Str if self.ignored($state, $version);
return Str unless self.write-state($state.add('pending-version'), $version);
$version
}
method run(IO::Path:D :$bundle-root!, :@args = @*ARGS --> Mu) {
return $!dispatch() unless self.eligible($bundle-root, @args);
my $state = self.state-root($bundle-root);
my $lock = self.acquire-lock($state);
return $!dispatch() unless $lock.defined;
LEAVE {
try { $lock.unlock }
try { $lock.close }
}
return $!dispatch() unless self.state-valid($state);
my $candidate = self.candidate($state, $!clock().Int);
return $!dispatch() unless $candidate.defined;
given $!prompt($candidate) {
when 'install' {
# Installer failures are deliberately visible. Discovery and
# state failures are policy noise; a chosen failed install is
# an action the user needs explained.
my $status = try { $!install($candidate) };
if $status.defined && $status == 0 {
try { $state.add('pending-version').unlink }
return $!exit(75);
}
else {
my $why = $! ?? $!.message !! "installer exited unsuccessfully";
note "{$!app-display}: could not install $candidate: $why";
}
}
when 'ignore' {
self.ignore($state, $candidate);
try { $state.add('pending-version').unlink }
}
default { } # ask next time: pending candidate stays intact
}
$!dispatch()
}
method !discover(Str:D $url --> Str) {
if $!installer-rel.ends-with('.ps1') {
# Windows PowerShell 5.1 is part of the installer contract; curl
# is not. Keep discovery on that same baseline and return only
# the final redirect URL for the strict repository/tag parser.
my $script = q[$ErrorActionPreference = 'Stop'; $response = Invoke-WebRequest -UseBasicParsing -Uri $args[0] -MaximumRedirection 1 -TimeoutSec 10; [Console]::Out.Write($response.BaseResponse.ResponseUri.AbsoluteUri)];
my $proc = try {
run 'powershell.exe', '-NoLogo', '-NoProfile', '-NonInteractive',
'-Command', $script, $url, :out, :err
};
return Str unless $proc.defined;
my $out = $proc.out.slurp(:close).trim;
$proc.err.slurp(:close);
return $proc.exitcode == 0 ?? $out !! Str;
}
my @cmd = 'curl', '--silent', '--show-error', '--fail',
'--location', '--connect-timeout', '3', '--max-time', '10',
'--proto', '=https', '--proto-redir', '=https',
'--max-redirs', '1', '--output', $*SPEC.devnull,
'--write-out', '%{url_effective}', $url;
my $proc = try { run |@cmd, :out, :err };
if $proc.defined {
my $out = $proc.out.slurp(:close).trim;
$proc.err.slurp(:close);
return $out if $proc.exitcode == 0;
}
# Minimal POSIX systems sometimes carry wget rather than curl. Its
# response trace is bounded by one redirect; the caller still accepts
# only the exact HTTPS GitHub release URL for this repository.
my $wget = try {
run 'wget', '--spider', '--server-response', '--max-redirect=1',
'--timeout=10', $url, :out, :err
};
return Str unless $wget.defined;
$wget.out.slurp(:close);
my $headers = $wget.err.slurp(:close);
return Str unless $wget.exitcode == 0;
my @locations = $headers.lines.map(*.trim).grep({
.lc.starts-with('location:')
}).map({ .substr(.index(':') + 1).trim.words[0] // '' }).grep(*.chars);
@locations ?? @locations.tail !! Str
}
method !prompt-user(Str:D $version --> Str) {
note "{$!app-display} $version is available (currently {$!app-version}).\n";
loop {
note "1. Install & use\n2. Ask next time\n3. Don't ask again for this version";
my $answer = $*IN.get;
return 'later' unless $answer.defined && $answer.trim.chars;
given $answer.trim {
when '1' { return 'install' }
when '2' { return 'later' }
when '3' { return 'ignore' }
default { note 'Choose 1, 2 or 3.' }
}
}
}
method !install-version(Str:D $version --> Int:D) {
my $root = $?FILE.IO.resolve.parent.parent.parent;
my $installer = $root.add($!installer-rel);
die "private installer is missing at $installer" unless $installer.f;
my $handoff = $!env{HANDOFF-ENV}
// die 'runner did not provide a private handoff path';
my $nonce = $!env{NONCE-ENV}
// die 'runner did not provide a private handoff nonce';
my @cmd = $installer.extension eq 'ps1'
?? ('powershell.exe', '-NoProfile', '-ExecutionPolicy', 'Bypass',
'-File', $installer.absolute,
'-ArizaUpdateCandidate', $version,
'-ArizaHandoff', $handoff,
'-ArizaNonce', $nonce,
'-ArizaExpectedCurrent', $root.absolute)
!! ($installer.absolute,
'--ariza-update-candidate', $version,
'--ariza-handoff', $handoff,
'--ariza-nonce', $nonce,
'--ariza-expected-current', $root.absolute);
my $proc = run |@cmd;
$proc.exitcode
}
method !dispatch-app() {
# The installed zef stub calls run-script in this process. It reads the
# existing @*ARGS and invokes the application's registered MAIN.
CompUnit::RepositoryRegistry.run-script($!app-exec)
}
method !is-managed-current(IO::Path:D $root --> Bool:D) {
my $managed = $root.parent.parent.add('current');
return False unless $managed.e || $managed.l;
my $resolved = try { $managed.resolve };
$resolved.defined && $resolved.absolute eq $root.resolve.absolute
}
method !ensure-dir(IO::Path:D $dir --> IO::Path:D) {
$dir.mkdir(:parents) unless $dir.d;
die "could not create $dir" unless $dir.d;
$dir
}
}
sub ariza-update-coordinator(--> Mu) is export {
Ariza::Update::Coordinator
}
# A launcher executes this file directly. EVALFILE-based tests get the class
# without accidentally dispatching an application MAIN.
if $*PROGRAM-NAME.IO.absolute eq $?FILE.IO.absolute {
my $root = $?FILE.IO.resolve.parent.parent.parent;
Ariza::Update::Coordinator.new.run(:bundle-root($root));
}