Michael Wesemann
1228 lines
43 KiB
Perl
Executable File
1228 lines
43 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#
|
|
# upd - download the matching binary from the latest Gitea/GitHub release.
|
|
#
|
|
# ./upd https://git.fhi.mpg.de/mike/mgsh
|
|
# ./upd https://github.com/sxyazi/yazi --install ~/bin --name yazi,ya
|
|
# ./upd --all # everything listed in the config file
|
|
# ./upd --all --check # exit 10 if any update is available
|
|
#
|
|
# Needs only Perl core modules plus curl (or wget) for HTTPS.
|
|
|
|
use strict;
|
|
use warnings;
|
|
use Getopt::Long qw(GetOptions);
|
|
use File::Basename qw(basename dirname);
|
|
use File::Spec;
|
|
use File::Temp qw(tempdir);
|
|
use POSIX qw(uname strftime);
|
|
use Digest::SHA qw(sha256_hex);
|
|
use JSON::PP ();
|
|
|
|
my $UA = 'upd/2.0 (perl)';
|
|
|
|
# Exit codes: 0 ok, 1 usage, 2 error, 10 update available (--check only).
|
|
use constant { EX_OK => 0, EX_USAGE => 1, EX_ERROR => 2, EX_OUTDATED => 10 };
|
|
|
|
# Options that belong to a single repository. Anything else is global and
|
|
# applies to every entry of an --all run.
|
|
my @SPEC_KEYS = qw(install name tag asset pattern os arch forge token version-flag pre);
|
|
|
|
my %opt = ('version-flag' => '--version', timeout => 30);
|
|
|
|
# Leftovers from an interrupted install must not linger next to the binary.
|
|
my @TMPFILES;
|
|
END { unlink @TMPFILES if @TMPFILES }
|
|
|
|
# Run only when executed directly, so the subs below can be require'd and
|
|
# exercised on their own.
|
|
main() unless caller;
|
|
|
|
sub main {
|
|
GetOptions(
|
|
\%opt,
|
|
'repo=s', 'tag=s', 'install|dest|i=s', 'name=s', 'asset=s', 'pattern=s',
|
|
'os=s', 'arch=s', 'token=s', 'forge=s', 'version-flag=s', 'timeout=i',
|
|
'config=s', 'all', 'check', 'pre', 'force', 'list', 'dry-run',
|
|
'quiet', 'verbose', 'help',
|
|
) or usage(EX_USAGE);
|
|
usage(EX_OK) if $opt{help};
|
|
$| = 1;
|
|
|
|
for my $sig (qw(INT TERM HUP)) {
|
|
$SIG{$sig} = sub { unlink @TMPFILES; @TMPFILES = (); exit 130 };
|
|
}
|
|
|
|
my @specs;
|
|
eval { @specs = build_specs(); 1 } or do {
|
|
warn trim($@) . "\n";
|
|
exit EX_ERROR;
|
|
};
|
|
|
|
my @results;
|
|
for my $spec (@specs) {
|
|
my $res = eval { update_one($spec) };
|
|
$res = { status => 'error', label => label_of($spec), msg => trim($@ || 'failed') }
|
|
unless defined $res;
|
|
push @results, $res;
|
|
warn "$res->{label}: $res->{msg}\n" if $res->{status} eq 'error';
|
|
}
|
|
|
|
summary(\@results) if @specs > 1 && !$opt{list};
|
|
exit worst_code(\@results);
|
|
}
|
|
|
|
sub build_specs {
|
|
if ($opt{all}) {
|
|
my $path = $opt{config} // config_path();
|
|
my @s = read_config($path);
|
|
die "No entries in $path.\n" unless @s;
|
|
return @s;
|
|
}
|
|
my $url = $opt{repo} // shift(@ARGV) // $ENV{UPD_REPO};
|
|
unless (defined $url && length $url) {
|
|
warn "Error: missing repository URL.\n\n";
|
|
usage(EX_USAGE);
|
|
}
|
|
my %s = (repo => $url);
|
|
$s{$_} = $opt{$_} for grep { defined $opt{$_} } @SPEC_KEYS;
|
|
return (\%s);
|
|
}
|
|
|
|
# ==============================================================================
|
|
# One repository, end to end
|
|
# ==============================================================================
|
|
|
|
sub update_one {
|
|
my $spec = shift;
|
|
|
|
my ($base, $owner, $repo) = parse_repo($spec->{repo});
|
|
my $forge = detect_forge($base, $spec->{forge});
|
|
my %ctx = (
|
|
base => $base,
|
|
owner => $owner,
|
|
repo => $repo,
|
|
forge => $forge,
|
|
token => resolve_token($forge, $spec->{token}),
|
|
api => api_base($base, $forge) . '/repos/' . uri_esc($owner) . '/' . uri_esc($repo),
|
|
);
|
|
|
|
my @names = parse_names($spec->{name} // $repo, $repo);
|
|
my ($os, $arch) = detect_platform($spec);
|
|
|
|
info("Repo: $base/$owner/$repo [$forge]");
|
|
info("Platform: $os/$arch");
|
|
|
|
my $rel = fetch_release(\%ctx, $spec);
|
|
my $tag = $rel->{tag_name};
|
|
|
|
if ($opt{list}) {
|
|
list_releases($rel->{_list} || [$rel]);
|
|
return { status => 'listed', label => $names[0]{out}, msg => '' };
|
|
}
|
|
|
|
info("Release: $tag ($rel->{published_at})" . ($rel->{prerelease} ? ' [prerelease]' : ''));
|
|
|
|
my @assets = @{ $rel->{assets} || [] };
|
|
die "Release $tag has no assets.\n" unless @assets;
|
|
|
|
my $asset = pick_asset(\@assets, $names[0]{src}, $os, $arch, $spec);
|
|
unless ($asset) {
|
|
my $have = join "\n ", map { $_->{name} } @assets;
|
|
die "No asset for $os/$arch in release $tag.\nAvailable:\n $have\n"
|
|
. "Select one explicitly with --asset <name> or --pattern <regex>.\n";
|
|
}
|
|
info("Asset: $asset->{name} (" . human_size($asset->{size}) . ")");
|
|
|
|
my @targets = resolve_targets($spec, \@names, $os);
|
|
info("Target: " . join(', ', map { $_->{dest} } @targets));
|
|
|
|
my @stale = grep { !target_current($_, $tag, $asset, $spec) } @targets;
|
|
unless (@stale || $opt{force}) {
|
|
info("Already up to date ($tag) - nothing to do.");
|
|
return { status => 'current', label => $names[0]{out}, msg => $tag };
|
|
}
|
|
@stale = @targets if $opt{force};
|
|
|
|
if ($opt{check}) {
|
|
my $have = join ', ', map { installed_tag($_) } @stale;
|
|
info("Update available: $tag (installed: $have)");
|
|
return { status => 'outdated', label => $names[0]{out}, msg => "$tag (have: $have)" };
|
|
}
|
|
|
|
my ($dl_url) = asset_url(\%ctx, $asset);
|
|
if ($opt{'dry-run'}) {
|
|
print "[dry-run] would download: $dl_url\n";
|
|
print "[dry-run] would install to: $_->{dest}\n" for @stale;
|
|
return { status => 'dry', label => $names[0]{out}, msg => $tag };
|
|
}
|
|
|
|
# --- download -------------------------------------------------------------
|
|
|
|
my $tmpdir = tempdir(CLEANUP => 1);
|
|
my $dl = File::Spec->catfile($tmpdir, $asset->{name});
|
|
|
|
info("Downloading $dl_url ...");
|
|
my (undef, $dl_hdr) = asset_url(\%ctx, $asset);
|
|
my $res = http_request(url => $dl_url, headers => { %{ auth_headers(\%ctx) }, %$dl_hdr },
|
|
file => $dl, progress => 1);
|
|
die "Download failed (HTTP $res->{status}): $dl_url\n" unless $res->{status} == 200;
|
|
|
|
my $got = -s $dl // 0;
|
|
die "Incomplete download: $got of $asset->{size} bytes.\n"
|
|
if $asset->{size} && $got < $asset->{size};
|
|
|
|
verify_download(\%ctx, $dl, $asset, \@assets, $tmpdir);
|
|
|
|
# --- extract and install --------------------------------------------------
|
|
|
|
my $root = extract_if_archive($dl, $tmpdir);
|
|
for my $t (@stale) {
|
|
my $src = defined $root ? find_in_tree($root, $t->{name})
|
|
: $dl;
|
|
die "Binary '$t->{name}' not found inside $asset->{name}.\n" unless defined $src;
|
|
warn "Warning: $t->{name} does not look like an executable.\n"
|
|
unless looks_executable($src);
|
|
|
|
install_atomic($src, $t->{dest});
|
|
strip_quarantine($t->{dest}) if $os eq 'darwin';
|
|
write_state($t, \%ctx, $spec, $tag, $asset);
|
|
info("Installed: $t->{dest} ($tag)");
|
|
my $v = installed_version($t->{dest}, $spec);
|
|
info("Version: $v") if length $v;
|
|
}
|
|
|
|
my %dirs = map { dirname($_->{dest}) => 1 } @stale;
|
|
warn "Note: $_ is not in \$PATH.\n" for grep { !in_path($_) } sort keys %dirs;
|
|
|
|
return { status => 'updated', label => $names[0]{out}, msg => $tag };
|
|
}
|
|
|
|
# ==============================================================================
|
|
# Release selection
|
|
# ==============================================================================
|
|
|
|
sub fetch_release {
|
|
my ($ctx, $spec) = @_;
|
|
|
|
# A specific tag: both forges have a direct endpoint. Fall back to the list
|
|
# so "26.5.6" also finds a tag named "v26.5.6".
|
|
if (defined $spec->{tag}) {
|
|
my $t = $spec->{tag};
|
|
my $hit = api_get($ctx, "$ctx->{api}/releases/tags/" . uri_esc($t), soft => 1);
|
|
return $hit if $hit && $hit->{tag_name};
|
|
my $list = api_get($ctx, releases_url($ctx));
|
|
($hit) = grep { $_->{tag_name} eq $t } @$list;
|
|
($hit) = grep { norm_ver($_->{tag_name}) eq norm_ver($t) } @$list unless $hit;
|
|
die "Release '$t' not found (--list shows all).\n" unless $hit;
|
|
return $hit;
|
|
}
|
|
|
|
# The plain case is one request: the forge already knows its latest
|
|
# non-draft, non-prerelease release.
|
|
unless ($spec->{pre} || $opt{list}) {
|
|
my $latest = api_get($ctx, "$ctx->{api}/releases/latest", soft => 1);
|
|
return $latest if $latest && $latest->{tag_name};
|
|
verbose('no /releases/latest, falling back to the release list');
|
|
}
|
|
|
|
my $list = api_get($ctx, releases_url($ctx));
|
|
die "No releases found in $ctx->{owner}/$ctx->{repo}.\n"
|
|
unless ref $list eq 'ARRAY' && @$list;
|
|
|
|
if ($opt{list}) {
|
|
return { tag_name => '', published_at => '', assets => [], _list => $list };
|
|
}
|
|
my ($rel) = grep { !$_->{draft} && ($spec->{pre} || !$_->{prerelease}) } @$list;
|
|
die "No suitable release found (try --pre).\n" unless $rel;
|
|
return $rel;
|
|
}
|
|
|
|
sub releases_url {
|
|
my $ctx = shift;
|
|
return $ctx->{forge} eq 'github' ? "$ctx->{api}/releases?per_page=50"
|
|
: "$ctx->{api}/releases?limit=50&draft=false";
|
|
}
|
|
|
|
# ==============================================================================
|
|
# Asset selection
|
|
# ==============================================================================
|
|
|
|
# Aliases commonly used in release asset names, including Rust target triples.
|
|
sub os_alias {
|
|
my $o = shift;
|
|
return $o eq 'darwin' ? [qw(darwin macos osx mac apple)]
|
|
: $o eq 'windows' ? [qw(windows win)]
|
|
: [$o];
|
|
}
|
|
|
|
# --- Asset name matching ------------------------------------------------------
|
|
|
|
# Can this machine turn the asset into a binary? Bare names and tarballs
|
|
# always qualify; single-file compression needs its decompressor present.
|
|
sub unpackable {
|
|
my $n = lc shift;
|
|
return 1 if $n =~ /\.(tar\.gz|tgz|tar\.bz2|tbz|tar\.xz|txz|tar\.zst|tzst|tar)$/;
|
|
return which('unzip') ? 1 : 0 if $n =~ /\.zip$/;
|
|
return (which('7zz') || which('7z') || which('7za')) ? 1 : 0 if $n =~ /\.7z$/;
|
|
return decompressor($1) ? 1 : 0 if $n =~ /\.(gz|bz2|xz|zst|lz4|lzma)$/;
|
|
return 0 if $n =~ /\.(rar|dmg|pkg|msi|deb|rpm)$/;
|
|
return 1; # bare binary or an unversioned name
|
|
}
|
|
|
|
# Compound tokens that name OS and architecture in one word. Rewritten before
|
|
# matching so the normal token rules apply. "win32" is Node-speak for Windows
|
|
# in general (pnpm-win32-x64.zip), so it contributes no architecture.
|
|
sub normalize_tokens {
|
|
my $n = shift;
|
|
$n =~ s/(?<![a-z0-9])win64(?![a-z0-9])/windows-amd64/g;
|
|
$n =~ s/(?<![a-z0-9])win32(?![a-z0-9])/windows/g;
|
|
return $n;
|
|
}
|
|
|
|
sub arch_alias {
|
|
my $a = shift;
|
|
return $a eq 'amd64' ? [qw(amd64 x86_64 x64 64bit)]
|
|
: $a eq 'arm64' ? [qw(arm64 aarch64)]
|
|
: $a eq '386' ? [qw(386 i386 i686 x86 32bit)]
|
|
: $a eq 'arm' ? [qw(arm armv7 armv6 armhf)]
|
|
: $a eq 'riscv64' ? [qw(riscv64 riscv64gc)]
|
|
: [$a];
|
|
}
|
|
|
|
# Glibc vs musl builds: pick what this system actually runs.
|
|
my $MUSL;
|
|
sub prefers_musl {
|
|
return $MUSL if defined $MUSL;
|
|
return $MUSL = 1 if -f '/etc/alpine-release';
|
|
my $ldd = which('ldd');
|
|
my $out = $ldd ? capture(5, $ldd, '--version') : '';
|
|
return $MUSL = $out =~ /musl/i ? 1 : 0;
|
|
}
|
|
|
|
# NB: no lexical $a/$b in here - they would shadow sort's globals below.
|
|
sub pick_asset {
|
|
my ($assets, $bin, $want_os, $want_arch, $spec) = @_;
|
|
|
|
if (defined $spec->{asset}) {
|
|
my ($hit) = grep { $_->{name} eq $spec->{asset} } @$assets;
|
|
die "Asset '$spec->{asset}' is not part of the release.\n" unless $hit;
|
|
return $hit;
|
|
}
|
|
if (defined $spec->{pattern}) {
|
|
my $re = qr/$spec->{pattern}/;
|
|
my ($hit) = grep { $_->{name} =~ $re } @$assets;
|
|
return $hit;
|
|
}
|
|
|
|
my $os_re = join '|', @{ os_alias($want_os) };
|
|
my @arches = @{ arch_alias($want_arch) };
|
|
# Universal macOS builds serve both architectures.
|
|
push @arches, qw(universal universal2) if $want_os eq 'darwin';
|
|
my $arch_re = join '|', @arches;
|
|
|
|
my (@cand, @rejected);
|
|
for my $as (@$assets) {
|
|
my $n = lc $as->{name};
|
|
my $m = normalize_tokens($n);
|
|
|
|
# Checksums, signatures and OS packages are not plain binaries.
|
|
if ($n =~ /\.(sha\d*|sha256sum|md5|asc|sig|pem|sbom|json|txt|deb|rpm|apk|dmg|pkg|msi|snap|flatpak|appimage)$/) {
|
|
push @rejected, "$n (not a binary)";
|
|
next;
|
|
}
|
|
# Cross-compile targets whose triples contain a host OS token:
|
|
# aarch64-linux-android is Android, not Linux.
|
|
if ($m =~ /(?:^|[^a-z0-9])(?:android\w*|ios|wasi|wasm\w*|emscripten)(?:[^a-z0-9]|$)/) {
|
|
push @rejected, "$n (foreign target)";
|
|
next;
|
|
}
|
|
unless ($m =~ /(?:^|[^a-z0-9])(?:$os_re)(?:[^a-z0-9]|$)/) {
|
|
push @rejected, "$n (os)";
|
|
next;
|
|
}
|
|
unless ($m =~ /(?:^|[^a-z0-9])(?:$arch_re)(?:[^a-z0-9]|$)/) {
|
|
push @rejected, "$n (arch)";
|
|
next;
|
|
}
|
|
# Keep 32-bit "arm" off "arm64" and "386" off "x86_64".
|
|
if ( ($want_arch eq 'arm' && $m =~ /arm64|aarch64/)
|
|
|| ($want_arch eq '386' && $m =~ /x86[_-]?64|amd64/)
|
|
|| ($want_arch eq 'amd64' && $m =~ /arm64|aarch64/)) {
|
|
push @rejected, "$n (wider arch)";
|
|
next;
|
|
}
|
|
|
|
my $score = 0;
|
|
$score += 10 if index($n, lc $bin) == 0; # named after the binary
|
|
$score += 3 if $n =~ /\.(tar\.gz|tgz|zip|tar\.xz|tar\.bz2|tar\.zst|tzst)$/ || $n !~ /\./;
|
|
$score -= 5 if $n =~ /debug|symbols|static-pie|profile/;
|
|
# Only avoid formats this machine has no tool for - restic, for one,
|
|
# ships nothing but .bz2, and bunzip2 handles that fine.
|
|
$score -= 8 if !unpackable($n);
|
|
|
|
# Toolchain preference is a tie-break, not a penalty: a project that
|
|
# ships musl only (or mingw only) must not be downranked for it.
|
|
my $pref = 0;
|
|
if ($want_os eq 'linux' && $n =~ /musl|gnu/) {
|
|
my $libc = prefers_musl() ? 'musl' : 'gnu';
|
|
$pref = $n =~ /\Q$libc\E/ ? 0 : 1;
|
|
}
|
|
elsif ($want_os eq 'windows' && $n =~ /msvc|gnu/) {
|
|
$pref = $n =~ /msvc/ ? 0 : 1; # msvc is the normal Windows build
|
|
}
|
|
push @cand, [ $score, $pref, length($n), $as ];
|
|
}
|
|
|
|
# Best score, then preferred toolchain, then the shortest name (which
|
|
# avoids special variants like -baseline or -static).
|
|
@cand = sort { $b->[0] <=> $a->[0] || $a->[1] <=> $b->[1] || $a->[2] <=> $b->[2] } @cand;
|
|
if ($opt{verbose}) {
|
|
verbose(sprintf 'candidate score=%-3d pref=%d %s', @{$_}[0, 1], $_->[3]{name}) for @cand;
|
|
verbose("rejected: $_") for @rejected;
|
|
}
|
|
return @cand ? $cand[0][3] : undef;
|
|
}
|
|
|
|
# ==============================================================================
|
|
# Install targets and state
|
|
# ==============================================================================
|
|
|
|
sub resolve_targets {
|
|
my ($spec, $names, $os) = @_;
|
|
my $want = $spec->{install} // $ENV{UPD_INSTALL};
|
|
$want =~ s{^~(?=/|$)}{$ENV{HOME} // '~'}e if defined $want;
|
|
my $ext = $os eq 'windows' ? '.exe' : '';
|
|
|
|
# --install is a directory unless it clearly points at a single binary:
|
|
# an existing file, or a last segment that is one of the binary names.
|
|
# Everything else is a directory (and gets created) - otherwise a config
|
|
# line like "install=~/bin" would create a *file* called bin.
|
|
my ($dir, $single);
|
|
if (defined $want && length $want) {
|
|
my $leaf = basename($want);
|
|
my $is_bin = grep { $leaf eq $_->{out} || $leaf eq $_->{out} . $ext } @$names;
|
|
if (!-d $want && ($is_bin || -f $want)) {
|
|
die "--install points at the file '$want' but " . scalar(@$names)
|
|
. " binaries were requested; give a directory instead.\n" if @$names > 1;
|
|
$single = $want;
|
|
$dir = dirname($want);
|
|
}
|
|
else {
|
|
($dir = $want) =~ s{(?<=.)/+$}{};
|
|
}
|
|
}
|
|
else {
|
|
$dir = default_dir($names->[0]{out});
|
|
}
|
|
make_dir($dir);
|
|
|
|
my @t;
|
|
for my $n (@$names) {
|
|
my $dest = $single // File::Spec->catfile($dir, $n->{out} . $ext);
|
|
# Replacing a symlink would silently break the link, so follow it.
|
|
if (-l $dest) {
|
|
require Cwd;
|
|
if (my $real = Cwd::abs_path($dest)) {
|
|
info("Note: $dest is a symlink, installing to $real");
|
|
$dest = $real;
|
|
}
|
|
}
|
|
push @t, { name => $n->{src}, out => $n->{out}, dest => $dest };
|
|
}
|
|
return @t;
|
|
}
|
|
|
|
# Without --install: replace the binary already on PATH, else ~/.local/bin.
|
|
sub default_dir {
|
|
my $bin = shift;
|
|
for my $dir (split /:/, ($ENV{PATH} // '')) {
|
|
next unless length $dir;
|
|
my $p = File::Spec->catfile($dir, $bin);
|
|
return $dir if -x $p && -w $dir;
|
|
}
|
|
return File::Spec->catdir($ENV{HOME} // '.', '.local', 'bin');
|
|
}
|
|
|
|
sub make_dir {
|
|
my $dir = shift;
|
|
return if -d $dir || $opt{'dry-run'} || $opt{list} || $opt{check};
|
|
require File::Path;
|
|
File::Path::make_path($dir)
|
|
or die "Cannot create target directory $dir: $!\n";
|
|
}
|
|
|
|
sub state_dir {
|
|
my $base = $ENV{XDG_STATE_HOME}
|
|
|| File::Spec->catdir($ENV{HOME} // '.', '.local', 'state');
|
|
return File::Spec->catdir($base, 'upd');
|
|
}
|
|
|
|
sub cache_dir {
|
|
my $base = $ENV{XDG_CACHE_HOME} || File::Spec->catdir($ENV{HOME} // '.', '.cache');
|
|
return File::Spec->catdir($base, 'upd');
|
|
}
|
|
|
|
# One state file per installed path; readable name plus a hash for uniqueness.
|
|
sub state_file {
|
|
my $dest = shift;
|
|
(my $key = $dest) =~ s{[^A-Za-z0-9._-]+}{_}g;
|
|
$key =~ s{^_+|_+$}{}g;
|
|
$key = substr($key, -70) if length $key > 70;
|
|
return File::Spec->catfile(state_dir(), $key . '.' . substr(sha256_hex($dest), 0, 8) . '.json');
|
|
}
|
|
|
|
# Identity of a release asset: the digest if the forge publishes one (GitHub
|
|
# does), otherwise its upload time - this is what makes rolling tags such as
|
|
# "nightly" detectable.
|
|
sub asset_stamp {
|
|
my $a = shift;
|
|
return $a->{digest} if $a->{digest};
|
|
return "t:$a->{updated_at}" if $a->{updated_at};
|
|
return "t:$a->{created_at}" if $a->{created_at};
|
|
return 's:' . ($a->{size} // 0);
|
|
}
|
|
|
|
sub target_current {
|
|
my ($t, $tag, $asset, $spec) = @_;
|
|
return 0 unless -f $t->{dest};
|
|
|
|
my $st = read_json(state_file($t->{dest}));
|
|
if ($st && defined $st->{tag}) {
|
|
return 0 unless $st->{tag} eq $tag;
|
|
return 0 unless ($st->{asset} // '') eq $asset->{name};
|
|
return 0 unless ($st->{stamp} // '') eq asset_stamp($asset);
|
|
# A locally replaced binary counts as out of date.
|
|
my $same = ($st->{binary_sha256} // '') eq file_sha256($t->{dest});
|
|
verbose("$t->{dest}: state matches but binary differs") unless $same;
|
|
return $same;
|
|
}
|
|
|
|
# No state yet (first run after an install by other means): ask the binary.
|
|
my $v = installed_version($t->{dest}, $spec);
|
|
verbose("$t->{dest}: no state file, binary reports '" . ($v // '') . "'");
|
|
return length($v) && $v eq norm_ver($tag) ? 1 : 0;
|
|
}
|
|
|
|
sub installed_tag {
|
|
my $t = shift;
|
|
my $st = read_json(state_file($t->{dest}));
|
|
return $st->{tag} if $st && defined $st->{tag};
|
|
return '-' unless -f $t->{dest};
|
|
my $v = installed_version($t->{dest}, {});
|
|
return length($v) ? $v : 'unknown';
|
|
}
|
|
|
|
sub write_state {
|
|
my ($t, $ctx, $spec, $tag, $asset) = @_;
|
|
make_dir_always(state_dir());
|
|
write_json(state_file($t->{dest}), {
|
|
dest => $t->{dest},
|
|
binary => $t->{out},
|
|
repo => "$ctx->{base}/$ctx->{owner}/$ctx->{repo}",
|
|
forge => $ctx->{forge},
|
|
tag => $tag,
|
|
asset => $asset->{name},
|
|
asset_size => $asset->{size},
|
|
stamp => asset_stamp($asset),
|
|
binary_sha256 => file_sha256($t->{dest}),
|
|
installed_at => strftime('%Y-%m-%dT%H:%M:%SZ', gmtime),
|
|
});
|
|
}
|
|
|
|
sub make_dir_always {
|
|
my $dir = shift;
|
|
return if -d $dir;
|
|
require File::Path;
|
|
File::Path::make_path($dir) or die "Cannot create $dir: $!\n";
|
|
}
|
|
|
|
# ==============================================================================
|
|
# Config file (--all)
|
|
# ==============================================================================
|
|
|
|
sub config_path {
|
|
my $base = $ENV{XDG_CONFIG_HOME} || File::Spec->catdir($ENV{HOME} // '.', '.config');
|
|
return File::Spec->catfile($base, 'upd', 'tools');
|
|
}
|
|
|
|
# One entry per line: <repo-url> [key=value ...] [pre]
|
|
sub read_config {
|
|
my $path = shift;
|
|
open my $fh, '<', $path
|
|
or die "Cannot read config $path: $!\n"
|
|
. "Format: one line per tool, e.g.\n"
|
|
. " https://github.com/sxyazi/yazi install=~/bin name=yazi,ya\n";
|
|
|
|
my (@out, $ln);
|
|
while (my $line = <$fh>) {
|
|
$ln++;
|
|
$line =~ s/^\s+|\s+$//g;
|
|
next if !length $line || $line =~ /^#/;
|
|
|
|
my @tok = map { unquote($_) } $line =~ /("(?:\\.|[^"])*"|\S+)/g;
|
|
my %s = (repo => shift @tok);
|
|
for my $t (@tok) {
|
|
my ($k, $v) = split /=/, $t, 2;
|
|
$k = lc $k;
|
|
die "$path:$ln: unknown key '$k' (allowed: " . join(', ', @SPEC_KEYS) . ")\n"
|
|
unless grep { $_ eq $k } @SPEC_KEYS;
|
|
$s{$k} = defined $v ? $v : 1;
|
|
}
|
|
# Global flags still win, so --force/--pre on the command line apply.
|
|
$s{$_} = $opt{$_} for grep { defined $opt{$_} } @SPEC_KEYS;
|
|
push @out, \%s;
|
|
}
|
|
close $fh;
|
|
return @out;
|
|
}
|
|
|
|
sub unquote {
|
|
my $s = shift;
|
|
if ($s =~ s/^"(.*)"$/$1/s) { $s =~ s/\\(.)/$1/g }
|
|
return $s;
|
|
}
|
|
|
|
# "yazi,ya" -> two binaries; "yazi:yazi-nightly" -> install yazi under a
|
|
# different file name. src is what to look for, out is what to write.
|
|
sub parse_names {
|
|
my ($list, $fallback) = @_;
|
|
my @n;
|
|
for my $part (split /\s*,\s*/, $list) {
|
|
next unless length $part;
|
|
my ($src, $out) = split /:/, $part, 2;
|
|
push @n, { src => $src, out => (defined $out && length $out) ? $out : $src };
|
|
}
|
|
return @n ? @n : ({ src => $fallback, out => $fallback });
|
|
}
|
|
|
|
sub label_of {
|
|
my $spec = shift;
|
|
return (parse_names($spec->{name}, '?'))[0]{out} if defined $spec->{name};
|
|
my $r = $spec->{repo} // '?';
|
|
$r =~ s{/+$}{};
|
|
return basename($r);
|
|
}
|
|
|
|
sub summary {
|
|
my $res = shift;
|
|
# --quiet is meant for cron: report only what needs attention.
|
|
my @rows = $opt{quiet}
|
|
? grep { $_->{status} =~ /^(error|outdated|updated)$/ } @$res
|
|
: @$res;
|
|
return unless @rows;
|
|
my $w = 0;
|
|
for (@rows) { $w = length $_->{label} if length $_->{label} > $w }
|
|
print "\nSummary:\n";
|
|
printf " %-9s %-*s %s\n", $_->{status}, $w, $_->{label}, $_->{msg} // '' for @rows;
|
|
}
|
|
|
|
sub worst_code {
|
|
my $res = shift;
|
|
return EX_ERROR if grep { $_->{status} eq 'error' } @$res;
|
|
return EX_OUTDATED if grep { $_->{status} eq 'outdated' } @$res;
|
|
return EX_OK;
|
|
}
|
|
|
|
# ==============================================================================
|
|
# HTTP
|
|
# ==============================================================================
|
|
|
|
# Use HTTP::Tiny only if it can really do TLS - otherwise curl/wget.
|
|
my $HTTP;
|
|
sub http_tiny {
|
|
return $HTTP if defined $HTTP;
|
|
$HTTP = eval {
|
|
require HTTP::Tiny;
|
|
HTTP::Tiny->can_ssl or die "no ssl\n";
|
|
HTTP::Tiny->new(agent => $UA, timeout => $opt{timeout}, verify_SSL => 1);
|
|
} || 0;
|
|
return $HTTP;
|
|
}
|
|
|
|
sub transport {
|
|
return 'tiny' if http_tiny();
|
|
return 'curl' if which('curl');
|
|
return 'wget' if which('wget');
|
|
die "Found neither a TLS-capable HTTP::Tiny nor curl/wget.\n";
|
|
}
|
|
|
|
# wget cannot report response headers usefully, so no conditional requests.
|
|
sub conditional_ok { return transport() ne 'wget' }
|
|
|
|
sub auth_headers {
|
|
my $ctx = shift;
|
|
return {} unless $ctx->{token};
|
|
# GitHub wants "Bearer", Gitea wants "token".
|
|
return { Authorization => $ctx->{forge} eq 'github' ? "Bearer $ctx->{token}"
|
|
: "token $ctx->{token}" };
|
|
}
|
|
|
|
# Returns { status, headers => {lc => value}, content } - content only when no
|
|
# 'file' was given. Never dies on HTTP status; callers decide.
|
|
sub http_request {
|
|
my %a = @_;
|
|
my $hdr = $a{headers} || {};
|
|
|
|
if (my $h = http_tiny()) {
|
|
my %o = (headers => $hdr);
|
|
my $out;
|
|
if ($a{file}) {
|
|
open $out, '>', $a{file} or die "Cannot write $a{file}: $!\n";
|
|
binmode $out;
|
|
$o{data_callback} = sub { print {$out} $_[0] };
|
|
}
|
|
my $r = $h->get($a{url}, \%o);
|
|
close $out if $out;
|
|
return { status => $r->{status}, headers => $r->{headers} || {},
|
|
content => $a{file} ? '' : $r->{content} };
|
|
}
|
|
|
|
my $tmp = tempdir(CLEANUP => 1);
|
|
my $body = $a{file} // File::Spec->catfile($tmp, 'body');
|
|
my $hf = File::Spec->catfile($tmp, 'head');
|
|
|
|
if (transport() eq 'wget') {
|
|
my @cmd = ('wget', '-q', '-O', $body, '--timeout', $opt{timeout}, "--user-agent=$UA",
|
|
map { "--header=$_: $hdr->{$_}" } sort keys %$hdr);
|
|
my $rc = system(@cmd, $a{url});
|
|
return { status => $rc == 0 ? 200 : 599, headers => {},
|
|
content => $a{file} ? '' : slurp($body) };
|
|
}
|
|
|
|
my @prog = ($a{progress} && !$opt{quiet} && -t STDOUT) ? ('--progress-bar') : ('-sS');
|
|
my @cmd = ('curl', @prog, '-L', '--retry', '2', '--connect-timeout', $opt{timeout},
|
|
'-A', $UA, '-D', $hf, '-o', $body, '-w', '%{http_code}',
|
|
map { ('-H', "$_: $hdr->{$_}") } sort keys %$hdr);
|
|
|
|
my $code = '';
|
|
if (open my $ph, '-|', @cmd, $a{url}) {
|
|
local $/;
|
|
$code = <$ph> // '';
|
|
close $ph;
|
|
}
|
|
my $rc = $? >> 8;
|
|
$code =~ s/\D//g;
|
|
die "curl failed (exit $rc): $a{url}\n" if $rc != 0 && !length $code;
|
|
die "curl failed (exit $rc, HTTP $code): $a{url}\n" if $rc != 0 && $code =~ /^[45]/;
|
|
|
|
return { status => $code || 599, headers => parse_headers($hf),
|
|
content => $a{file} ? '' : slurp($body) };
|
|
}
|
|
|
|
# Keep only the last response block; -L may have walked through redirects.
|
|
sub parse_headers {
|
|
my $path = shift;
|
|
open my $fh, '<', $path or return {};
|
|
my %h;
|
|
while (my $l = <$fh>) {
|
|
$l =~ s/\r?\n$//;
|
|
%h = () , next if $l =~ m{^HTTP/};
|
|
$h{lc $1} = $2 if $l =~ /^([^:]+):\s*(.*)$/;
|
|
}
|
|
close $fh;
|
|
return \%h;
|
|
}
|
|
|
|
sub slurp {
|
|
my $path = shift;
|
|
open my $fh, '<', $path or return '';
|
|
binmode $fh;
|
|
local $/;
|
|
return <$fh> // '';
|
|
}
|
|
|
|
# GET a JSON API endpoint, revalidating a cached copy via ETag where supported.
|
|
# soft => 1 returns undef instead of dying on 404.
|
|
sub api_get {
|
|
my ($ctx, $url, %o) = @_;
|
|
my $accept = $ctx->{forge} eq 'github' ? 'application/vnd.github+json' : 'application/json';
|
|
my %hdr = (%{ auth_headers($ctx) }, Accept => $accept);
|
|
$hdr{'X-GitHub-Api-Version'} = '2022-11-28' if $ctx->{forge} eq 'github';
|
|
|
|
my $cf = cache_file($url);
|
|
my $cached = read_json($cf);
|
|
$hdr{'If-None-Match'} = $cached->{etag}
|
|
if $cached && $cached->{etag} && conditional_ok();
|
|
|
|
my $r = http_request(url => $url, headers => \%hdr);
|
|
|
|
if ($r->{status} == 304 && $cached) {
|
|
verbose("304 not modified, using cached $url");
|
|
return decode_json_or_die($cached->{body}, $url, $ctx);
|
|
}
|
|
return undef if $o{soft} && $r->{status} == 404;
|
|
if ($r->{status} == 403 || $r->{status} == 429) {
|
|
my $left = $r->{headers}{'x-ratelimit-remaining'};
|
|
die "$ctx->{forge} rate limit reached"
|
|
. (defined $left ? " (remaining: $left)" : '')
|
|
. ". Set a token via --token or \$GITHUB_TOKEN.\n"
|
|
if defined $left && $left eq '0';
|
|
}
|
|
die "HTTP $r->{status}: $url\n" unless $r->{status} == 200;
|
|
|
|
my $data = decode_json_or_die($r->{content}, $url, $ctx);
|
|
if (my $etag = $r->{headers}{etag}) {
|
|
make_dir_always(cache_dir());
|
|
write_json($cf, { url => $url, etag => $etag, body => $r->{content} });
|
|
}
|
|
return $data;
|
|
}
|
|
|
|
sub decode_json_or_die {
|
|
my ($body, $url, $ctx) = @_;
|
|
my $data = eval { JSON::PP->new->utf8->decode($body) };
|
|
die "Response from $url is not JSON (is this really a $ctx->{forge} instance?).\n"
|
|
unless defined $data;
|
|
die ucfirst($ctx->{forge}) . " error: $data->{message}\n"
|
|
if ref $data eq 'HASH' && $data->{message};
|
|
return $data;
|
|
}
|
|
|
|
sub cache_file {
|
|
my $url = shift;
|
|
return File::Spec->catfile(cache_dir(), substr(sha256_hex($url), 0, 16) . '.json');
|
|
}
|
|
|
|
# Private GitHub assets are only reachable through the API URL; curl/HTTP::Tiny
|
|
# drop the Authorization header on the cross-host redirect to storage.
|
|
sub asset_url {
|
|
my ($ctx, $a) = @_;
|
|
return ("$ctx->{api}/releases/assets/$a->{id}", { Accept => 'application/octet-stream' })
|
|
if $ctx->{forge} eq 'github' && $ctx->{token} && $a->{id};
|
|
return ($a->{browser_download_url}, {});
|
|
}
|
|
|
|
# ==============================================================================
|
|
# Verification, extraction, installation
|
|
# ==============================================================================
|
|
|
|
sub verify_download {
|
|
my ($ctx, $file, $asset, $assets, $tmpdir) = @_;
|
|
|
|
my ($want, $src);
|
|
if (($asset->{digest} // '') =~ /^sha256:([0-9a-f]{64})$/i) {
|
|
($want, $src) = (lc $1, 'asset digest');
|
|
}
|
|
else {
|
|
my ($sum) = grep { $_->{name} eq "$asset->{name}.sha256" } @$assets;
|
|
($sum) = grep { $_->{name} =~ /^(sha256sums?(\.txt)?|checksums?\.txt)$/i } @$assets
|
|
unless $sum;
|
|
return unless $sum;
|
|
|
|
my $sf = File::Spec->catfile($tmpdir, 'sums');
|
|
my ($u, $h) = asset_url($ctx, $sum);
|
|
my $r = eval {
|
|
http_request(url => $u, headers => { %{ auth_headers($ctx) }, %$h }, file => $sf);
|
|
};
|
|
unless ($r && $r->{status} == 200) {
|
|
warn "Checksum file could not be downloaded, skipping verification.\n";
|
|
return;
|
|
}
|
|
open my $fh, '<', $sf or return;
|
|
while (my $l = <$fh>) {
|
|
# "<hash> <name>", or just "<hash>" in a single-file .sha256
|
|
next unless my ($hash, $fn) = $l =~ /^([0-9a-fA-F]{64})(?:\s+\*?(\S+))?/;
|
|
next if defined $fn && basename($fn) ne $asset->{name};
|
|
($want, $src) = (lc $hash, $sum->{name});
|
|
last;
|
|
}
|
|
close $fh;
|
|
return unless $want;
|
|
}
|
|
|
|
my $got = file_sha256($file);
|
|
die "SHA256 mismatch ($src)!\n expected: $want\n got: $got\n" if $got ne $want;
|
|
info("SHA256: ok ($src)");
|
|
}
|
|
|
|
sub file_sha256 {
|
|
my $path = shift;
|
|
open my $fh, '<', $path or die "Cannot read $path: $!\n";
|
|
binmode $fh;
|
|
my $d = Digest::SHA->new(256)->addfile($fh)->hexdigest;
|
|
close $fh;
|
|
return $d;
|
|
}
|
|
|
|
# Single-file compression: the asset is the binary, just squeezed. Each entry
|
|
# lists the tools that can expand it, in order of preference; the first one
|
|
# found wins. All of them write to stdout with the flags given.
|
|
sub DECOMP {
|
|
return {
|
|
gz => { tools => [qw(gzip gunzip)], args => ['-dc'] },
|
|
bz2 => { tools => [qw(bzip2 bunzip2)], args => ['-dc'] },
|
|
xz => { tools => [qw(xz unxz)], args => ['-dc'] },
|
|
lzma => { tools => [qw(xz unxz lzma)], args => ['-dc'] },
|
|
zst => { tools => [qw(zstd unzstd)], args => ['-dcq'] },
|
|
lz4 => { tools => [qw(lz4 unlz4)], args => ['-dcq'] },
|
|
};
|
|
}
|
|
|
|
sub decompressor {
|
|
my $ext = shift;
|
|
my $e = DECOMP()->{$ext} or return;
|
|
for my $t (@{ $e->{tools} }) {
|
|
my $p = which($t) or next;
|
|
return { prog => $p, args => $e->{args} };
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub decompress_to {
|
|
my ($dec, $src, $dst) = @_;
|
|
open my $out, '>', $dst or die "Cannot write $dst: $!\n";
|
|
binmode $out;
|
|
my $pid = open my $in, '-|';
|
|
die "fork failed: $!\n" unless defined $pid;
|
|
unless ($pid) {
|
|
open STDIN, '<', File::Spec->devnull;
|
|
exec $dec->{prog}, @{ $dec->{args} }, $src;
|
|
exit 127;
|
|
}
|
|
binmode $in;
|
|
my $buf;
|
|
print {$out} $buf while read $in, $buf, 1 << 20;
|
|
close $in;
|
|
my $rc = $?;
|
|
close $out or die "Error writing $dst: $!\n";
|
|
die "Failed to decompress $src (" . basename($dec->{prog}) . " exit "
|
|
. ($rc >> 8) . ").\n" if $rc != 0;
|
|
}
|
|
|
|
# Returns the root of the extracted tree, or undef if the asset is a bare
|
|
# binary (then the download itself is the binary).
|
|
sub extract_if_archive {
|
|
my ($file, $tmpdir) = @_;
|
|
my $lc = lc basename($file);
|
|
|
|
my $out = File::Spec->catdir($tmpdir, 'x');
|
|
|
|
if ($lc =~ /\.(tar\.gz|tgz|tar\.bz2|tbz|tar\.xz|txz|tar\.zst|tzst|tar)$/) {
|
|
mkdir $out or die "mkdir $out: $!\n";
|
|
system('tar', '-xf', $file, '-C', $out) == 0 or die "Failed to extract $file.\n";
|
|
}
|
|
elsif ($lc =~ /\.zip$/) {
|
|
which('unzip') or die "unzip not found, but needed for $lc.\n";
|
|
mkdir $out or die "mkdir $out: $!\n";
|
|
system('unzip', '-q', $file, '-d', $out) == 0 or die "Failed to extract $file.\n";
|
|
}
|
|
elsif ($lc =~ /\.7z$/) {
|
|
my $z = which('7zz') || which('7z') || which('7za')
|
|
or die "7z not found, but needed for $lc.\n";
|
|
mkdir $out or die "mkdir $out: $!\n";
|
|
system($z, 'x', '-y', "-o$out", $file) == 0 or die "Failed to extract $file.\n";
|
|
}
|
|
elsif (my ($ext) = $lc =~ /\.(gz|bz2|xz|zst|lz4|lzma)$/) {
|
|
# A single compressed file, e.g. restic_0.19.1_darwin_arm64.bz2 -
|
|
# the binary itself, just squeezed.
|
|
my $dec = decompressor($ext)
|
|
or die "Cannot unpack .$ext - install " . join('/', @{ DECOMP()->{$ext}{tools} })
|
|
. " or pick another asset with --asset/--pattern.\n";
|
|
mkdir $out or die "mkdir $out: $!\n";
|
|
(my $stem = basename($file)) =~ s/\.\Q$ext\E$//i;
|
|
my $plain = File::Spec->catfile($out, $stem);
|
|
decompress_to($dec, $file, $plain);
|
|
}
|
|
else {
|
|
return undef; # bare binary
|
|
}
|
|
return $out;
|
|
}
|
|
|
|
# Look for a file called $name; fall back to the single executable in the tree.
|
|
sub find_in_tree {
|
|
my ($root, $name) = @_;
|
|
|
|
my @found;
|
|
my @stack = ($root);
|
|
while (my $dir = pop @stack) {
|
|
opendir my $dh, $dir or next;
|
|
for my $e (readdir $dh) {
|
|
next if $e eq '.' || $e eq '..';
|
|
my $p = File::Spec->catfile($dir, $e);
|
|
if (-d $p) { push @stack, $p; next }
|
|
push @found, $p;
|
|
}
|
|
closedir $dh;
|
|
}
|
|
|
|
my ($exact) = grep { basename($_) eq $name || basename($_) eq "$name.exe" } @found;
|
|
return $exact if $exact;
|
|
|
|
my @exec = grep { looks_executable($_) } @found;
|
|
return $exec[0] if @exec == 1;
|
|
verbose("archive contains " . scalar(@found) . " files, "
|
|
. scalar(@exec) . " of them executable");
|
|
return undef;
|
|
}
|
|
|
|
# Magic bytes beat guessing by file size: ELF, Mach-O (incl. fat), PE, script.
|
|
sub looks_executable {
|
|
my $path = shift;
|
|
open my $fh, '<', $path or return 0;
|
|
binmode $fh;
|
|
read $fh, my $m, 4;
|
|
close $fh;
|
|
return 0 unless defined $m && length $m >= 2;
|
|
return 1 if $m =~ /^\x7fELF/;
|
|
return 1 if $m =~ /^(?:\xcf\xfa\xed\xfe|\xce\xfa\xed\xfe|\xca\xfe\xba\xbe|\xbe\xba\xfe\xca)/;
|
|
return 1 if $m =~ /^MZ/;
|
|
return 1 if $m =~ /^#!/;
|
|
return 0;
|
|
}
|
|
|
|
sub install_atomic {
|
|
my ($src, $dest) = @_;
|
|
my $dir = dirname($dest);
|
|
-d $dir or die "Target directory $dir does not exist.\n";
|
|
-w $dir or die "No write permission in $dir (use sudo, or pick another --install path).\n";
|
|
|
|
my $tmp = "$dest.new.$$";
|
|
push @TMPFILES, $tmp;
|
|
open my $in, '<', $src or die "Cannot read $src: $!\n";
|
|
open my $out, '>', $tmp or die "Cannot write $tmp: $!\n";
|
|
binmode $in;
|
|
binmode $out;
|
|
my $buf;
|
|
print {$out} $buf while read $in, $buf, 1 << 20;
|
|
close $in;
|
|
close $out or die "Error writing $tmp: $!\n";
|
|
chmod 0755, $tmp;
|
|
|
|
# rename is atomic and works even while $dest is currently running.
|
|
rename $tmp, $dest or do {
|
|
my $err = $!;
|
|
unlink $tmp;
|
|
die "Cannot replace $dest: $err\n";
|
|
};
|
|
@TMPFILES = grep { $_ ne $tmp } @TMPFILES;
|
|
}
|
|
|
|
sub strip_quarantine {
|
|
my $dest = shift;
|
|
return unless -x '/usr/bin/xattr';
|
|
system(qq{/usr/bin/xattr -d com.apple.quarantine \Q$dest\E >/dev/null 2>&1});
|
|
}
|
|
|
|
# ==============================================================================
|
|
# Helpers
|
|
# ==============================================================================
|
|
|
|
sub info { print "$_[0]\n" unless $opt{quiet} }
|
|
sub verbose { print " $_[0]\n" if $opt{verbose} }
|
|
sub trim { my $s = shift // ''; $s =~ s/^\s+|\s+$//g; return $s }
|
|
|
|
sub parse_repo {
|
|
my $url = shift;
|
|
$url =~ s{/+$}{};
|
|
$url =~ s{\.git$}{};
|
|
$url = "https://$url" unless $url =~ m{^https?://};
|
|
my ($scheme_host, $path) = $url =~ m{^(https?://[^/]+)(/.*)?$}
|
|
or die "Cannot parse repository URL: $url\n";
|
|
$path //= '';
|
|
$path =~ s{^/}{};
|
|
# Anything before <owner>/<repo> is a base path (Gitea under a sub-path).
|
|
my @seg = split m{/}, $path;
|
|
die "Repository URL needs <owner>/<repo>: $url\n" if @seg < 2;
|
|
my ($o, $r) = splice @seg, -2;
|
|
return ($scheme_host . (@seg ? '/' . join('/', @seg) : ''), $o, $r);
|
|
}
|
|
|
|
sub uri_esc {
|
|
my $s = shift;
|
|
$s =~ s{([^A-Za-z0-9._~-])}{sprintf '%%%02X', ord $1}ge;
|
|
return $s;
|
|
}
|
|
|
|
sub host_of { my ($h) = ($_[0] // '') =~ m{^https?://([^/:]+)}i; return lc($h // '') }
|
|
|
|
# Gitea and GitHub expose the same release JSON, only under different API
|
|
# roots and with different auth headers.
|
|
sub detect_forge {
|
|
my ($b, $override) = @_;
|
|
if (defined $override) {
|
|
my $f = lc $override;
|
|
die "Unknown forge '$override' (use github or gitea).\n"
|
|
unless $f eq 'github' || $f eq 'gitea';
|
|
return $f;
|
|
}
|
|
return host_of($b) =~ /(^|\.)github\.com$/ ? 'github' : 'gitea';
|
|
}
|
|
|
|
sub api_base {
|
|
my ($b, $f) = @_;
|
|
return "$b/api/v1" unless $f eq 'github';
|
|
return 'https://api.github.com' if host_of($b) =~ /(^|\.)github\.com$/;
|
|
return "$b/api/v3"; # GitHub Enterprise
|
|
}
|
|
|
|
sub resolve_token {
|
|
my ($forge, $explicit) = @_;
|
|
return $explicit if defined $explicit;
|
|
my @env = $forge eq 'github' ? qw(UPD_TOKEN GITHUB_TOKEN GH_TOKEN)
|
|
: qw(UPD_TOKEN GITEA_TOKEN);
|
|
for my $k (@env) {
|
|
return $ENV{$k} if defined $ENV{$k} && length $ENV{$k};
|
|
}
|
|
return '';
|
|
}
|
|
|
|
sub detect_platform {
|
|
my $spec = shift || {};
|
|
my ($sysname, undef, undef, undef, $machine) = uname();
|
|
my $o = lc $sysname;
|
|
$o = 'windows' if $o =~ /mingw|msys|cygwin|windows/;
|
|
$o = 'darwin' if $o =~ /darwin/;
|
|
$o = 'linux' if $o =~ /linux/;
|
|
|
|
my $m = lc $machine;
|
|
my $a = $m =~ /^(x86_64|amd64)$/ ? 'amd64'
|
|
: $m =~ /^(aarch64|arm64)$/ ? 'arm64'
|
|
: $m =~ /^(i[3-6]86|x86)$/ ? '386'
|
|
: $m =~ /^armv?[5-8]/ ? 'arm'
|
|
: $m =~ /^(ppc64le|riscv64|s390x)$/ ? $m
|
|
: $m;
|
|
|
|
return ($spec->{os} // $o, $spec->{arch} // $a);
|
|
}
|
|
|
|
sub in_path {
|
|
my $dir = shift;
|
|
return grep { $_ eq $dir } split /:/, ($ENV{PATH} // '');
|
|
}
|
|
|
|
sub norm_ver { my $v = shift // ''; $v =~ s/^v//i; $v =~ s/^\s+|\s+$//g; return $v }
|
|
|
|
# Run a program and capture stdout+stderr, with a timeout and no stdin.
|
|
sub capture {
|
|
my ($timeout, $prog, @args) = @_;
|
|
my $pid = open my $fh, '-|';
|
|
return '' unless defined $pid;
|
|
unless ($pid) {
|
|
open STDIN, '<', File::Spec->devnull;
|
|
open STDERR, '>&', \*STDOUT;
|
|
exec $prog, @args;
|
|
exit 127;
|
|
}
|
|
my $out = '';
|
|
local $SIG{ALRM} = sub { kill 'TERM', $pid };
|
|
alarm $timeout;
|
|
{ local $/; $out = <$fh> // '' }
|
|
alarm 0;
|
|
close $fh;
|
|
return $out;
|
|
}
|
|
|
|
# Legacy fallback: ask the binary for its version (used when no state exists).
|
|
sub installed_version {
|
|
my ($path, $spec) = @_;
|
|
return '' unless -x $path;
|
|
my $flag = $spec->{'version-flag'} // $opt{'version-flag'};
|
|
my $out = capture(10, $path, $flag);
|
|
my ($v) = $out =~ /(\d+\.\d+(?:\.\d+)*(?:[-+][\w.]+)?)/;
|
|
return norm_ver($v);
|
|
}
|
|
|
|
sub list_releases {
|
|
my $rels = shift;
|
|
for my $r (@$rels) {
|
|
printf "%-12s %s%s\n", $r->{tag_name}, substr($r->{published_at} // '', 0, 10),
|
|
$r->{prerelease} ? ' [prerelease]' : '';
|
|
printf " %-32s %s\n", $_->{name}, human_size($_->{size})
|
|
for @{ $r->{assets} || [] };
|
|
}
|
|
}
|
|
|
|
sub human_size {
|
|
my $n = shift // 0;
|
|
return sprintf '%.1f MB', $n / 1024 / 1024 if $n >= 1024 * 1024;
|
|
return sprintf '%.1f kB', $n / 1024 if $n >= 1024;
|
|
return "$n B";
|
|
}
|
|
|
|
sub which {
|
|
my $cmd = shift;
|
|
for my $dir (split /:/, ($ENV{PATH} // '')) {
|
|
my $p = File::Spec->catfile($dir, $cmd);
|
|
return $p if -x $p && !-d $p;
|
|
}
|
|
return;
|
|
}
|
|
|
|
sub read_json {
|
|
my $path = shift;
|
|
return undef unless -f $path;
|
|
my $body = slurp($path);
|
|
return eval { JSON::PP->new->utf8->decode($body) };
|
|
}
|
|
|
|
sub write_json {
|
|
my ($path, $data) = @_;
|
|
my $tmp = "$path.$$";
|
|
push @TMPFILES, $tmp;
|
|
open my $fh, '>', $tmp or die "Cannot write $tmp: $!\n";
|
|
print {$fh} JSON::PP->new->utf8->canonical->pretty->encode($data);
|
|
close $fh or die "Cannot write $tmp: $!\n";
|
|
rename $tmp, $path or die "Cannot update $path: $!\n";
|
|
@TMPFILES = grep { $_ ne $tmp } @TMPFILES;
|
|
}
|
|
|
|
sub usage {
|
|
my $rc = shift;
|
|
print <<"USAGE";
|
|
upd - download the matching binary from the latest Gitea/GitHub release
|
|
|
|
upd [OPTIONS] REPO-URL
|
|
upd --all [OPTIONS]
|
|
|
|
REPO-URL e.g. https://git.fhi.mpg.de/mike/mgsh
|
|
https://github.com/sxyazi/yazi
|
|
(or use --repo / \$UPD_REPO)
|
|
|
|
Options:
|
|
--install PATH, -i target directory (created if missing), e.g. ~/bin.
|
|
A path whose last segment is one of the binary names,
|
|
or an existing file, means that exact file.
|
|
Also \$UPD_INSTALL. Default: the directory of a
|
|
same-named binary in \$PATH, else ~/.local/bin
|
|
--name A[,B...] binary name(s) to take out of one asset, e.g.
|
|
"yazi,ya" installs both. Use "SRC:DST" to install
|
|
under a different name (default: repository name)
|
|
--all update every entry of the config file
|
|
--config PATH config file (default: ~/.config/upd/tools)
|
|
--check only report whether an update is available
|
|
--tag VERSION install a specific release ("v1.2.3" or "1.2.3")
|
|
--pre consider prereleases as well
|
|
--asset NAME exact asset name instead of auto-detection
|
|
--pattern REGEX select the asset by regex
|
|
--os OS darwin|linux|windows|freebsd (default: detected)
|
|
--arch ARCH amd64|arm64|386|arm (default: detected)
|
|
--forge NAME github|gitea (default: github for github.com hosts,
|
|
gitea otherwise; needed for GitHub Enterprise)
|
|
--token TOKEN API token for private repositories. Also read from
|
|
\$UPD_TOKEN, then \$GITHUB_TOKEN/\$GH_TOKEN (GitHub)
|
|
or \$GITEA_TOKEN (Gitea)
|
|
--version-flag F flag to query the version of a binary installed
|
|
without upd (default: --version)
|
|
--force install even if it is already up to date
|
|
--list show releases and their assets
|
|
--dry-run show what would happen, write nothing
|
|
--verbose show asset scoring and cache decisions
|
|
--quiet print errors only
|
|
--timeout SEC network timeout (default: 30)
|
|
--help this help
|
|
|
|
Config file (one line per tool, "#" comments):
|
|
https://git.fhi.mpg.de/mike/mgsh install=~/bin
|
|
https://github.com/sxyazi/yazi install=~/bin name=yazi,ya
|
|
Keys: @{[ join ', ', @SPEC_KEYS ]}
|
|
|
|
State is kept in @{[ state_dir() ]}
|
|
Exit codes: 0 ok, 1 usage, 2 error, 10 update available (--check)
|
|
USAGE
|
|
exit $rc;
|
|
}
|
|
|
|
1;
|