#!/usr/bin/perl -w
# nailing-cargo: wrapper to use unpublished local crates
#
# Copyright (C) 2019-2020 Ian Jackson
#
# This program is free software: you can redistribute it and/or modify
# it under the terms of the GNU Affero General Public License as
# published by the Free Software Foundation, either version 3 of the
# License, or (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU Affero General Public License for more details.
#
# You should have received a copy of the GNU Affero General Public License
# along with this program. If not, see .
# example usages:
# ../nailing-cargo/nailing-caretwgo make
# ../nailing-cargo/nailing-cargo cargo build
# CARGO='../nailing-cargo/nailing-cargo cargo' make
# Why do we need this ?
#
# https://github.com/rust-lang/cargo/issues/6713
# https://stackoverflow.com/questions/33025887/how-to-use-a-local-unpublished-crate
# https://github.com/rust-lang/cargo/issues/1481
# Needs libtoml-perl
#: Cargo.nail:
#
# [packages]
# package = subdir
# package = { subdir = ... }
#
# [subdirs]
# subdir
use strict;
use TOML;
use POSIX;
use Fcntl qw(LOCK_EX);
use File::Compare;
my $self = $0; $self =~ s{^.*/(?=.)}{};
our $worksphere = getcwd() // die "$self: getcwd failed: $!\n";
$worksphere =~ s{/[^/]+}{} or die "$self: cwd \`$worksphere' unsupported!\n";
our $lockfile = "../.nailing-cargo-sphere.lock";
our @configs;
sub read_or_enoent ($) {
my ($fn) = @_;
if (!open R, '<', $fn) {
return undef if $!==ENOENT;
die "$self: open $fn: $!\n";
}
local ($/) = undef;
my ($r) = // die "$self: read $fn: $!\n";
$r;
}
sub toml_or_enoent ($$) {
my ($f,$what) = @_;
my $toml = read_or_enoent($f) // return;
my ($v,$e) = from_toml($toml);
die "$self: parse TOML: $what: $f: $e\n" unless defined $v;
die "$e ?" if length $e;
$v;
}
sub load1config ($) {
my ($f) = @_;
my $toml = toml_or_enoent($f, "config file");
push @configs, $toml if defined $toml;
}
sub loadconfigs () {
my $cfgleaf = ".nailing-cargo-cfg.toml";
load1config("/etc/nailing-cargo/cfg.toml");
load1config("$worksphere/$cfgleaf");
load1config("$ENV{HOME}/$cfgleaf") if defined $ENV{HOME};
}
sub getcfg ($$) {
my ($k, $def) = @_;
foreach my $cfg (@configs) {
my $v = $cfg->{$k};
return $v if defined $v;
}
return $def;
}
sub takelock () {
for (;;) {
open LOCK, ">", $lockfile or die "$self: open/create $lockfile: $!\n";
flock LOCK, LOCK_EX or die "$self: lock $lockfile: $!\n";
my @fstat = stat LOCK or die "$self: fstat: $!\n";
my @stat = stat $lockfile;
if (!@stat) {
next if $! == ENOENT;
die "$self: stat $lockfile: $!\n";
}
last if "@fstat[0..5]" eq "@stat[0..5]";
}
}
sub unlock () {
unlink $lockfile or die "$self: removing lockfile: $!\n";
}
our $nail;
sub readnail () {
my $nailfile = "../Cargo.nail";
open N, '<', $nailfile or die "$self: open $nailfile: $!\n";
local ($/) = undef;
my $toml = // die "$self: read $nailfile: $!";
my $transformed;
if ($toml !~ m{^\s*\[/}m &&
$toml !~ m{^[^\n\#]*\=}m &&
# old non-toml syntax
$toml =~ s{^[ \t]*([-_0-9a-z]+)[ \t]+(\S+)[ \t]*$}{$1 = \"$2\"}mig) {
$toml =~ s{^}{[packages\]\n};
$transformed = 1;
}
my $e;
($nail,$e) = from_toml($toml);
if (!defined $nail) {
if ($transformed) {
$toml =~ s/^/ /mg;
print STDERR "$self: $nailfile transformed into TOML:\n$toml\n";
}
die "$self: parse $nailfile: $e\n";
}
die "$e ?" if length $e;
}
our %manifests;
our %packagemap;
sub read_manifest ($) {
my ($subdir) = @_;
my $manifest = "../$subdir/Cargo.toml";
if (defined $manifests{$manifest}) {
print STDERR
"$self: warning: $subdir: specified more than once!\n";
return undef;
}
foreach my $try ("$manifest.unnailed", "$manifest") {
my $toml = toml_or_enoent($try, "package manifest") // next;
my $p = $toml->{package}{name};
if (!defined $p) {
print STDERR
"$self: warning: $subdir: missing package.name in $try, ignoring\n";
next;
}
$manifests{$manifest} = $toml;
return $p;
}
return undef;
}
sub readorigs () {
foreach my $p (keys %{ $nail->{packages} }) {
my $v = $nail->{packages}{$p};
my $subdir = ref($v) ? $v->{subdir} : $v;
my $gotpackage = read_manifest($subdir) // '';
if ($gotpackage ne $p) {
print STDERR
"$self: warning: honouring Cargo.nail [packages.$subdir]=$p even though $subdir contains package $gotpackage!\n";
}
die if defined $packagemap{$p};
$packagemap{$p} = $subdir;
}
foreach my $subdir (@{ $nail->{subdirs} }) {
my $gotpackage = read_manifest($subdir);
if (!defined $gotpackage) {
print STDERR
"$self: warning: ignoring subdir $subdir which has no Cargo.toml\n";
next;
}
$packagemap{$gotpackage} //= $subdir;
}
}
sub calculate () {
foreach my $mf (keys %manifests) {
my $toml = $manifests{$mf};
foreach my $k (qw(dependencies build-dependencies dev-dependencies)) {
my $deps = $toml->{$k};
next unless $deps;
foreach my $p (keys %packagemap) {
my $info = $deps->{$p};
next unless $info;
$info = { } unless ref $info;
delete $info->{version};
$info->{path} = $packagemap{$p};
}
}
my $nailing = "$mf.nailing~";
unlink $nailing or $!==ENOENT or die "$self: remove old $nailing: $!\n";
open N, '>', $nailing or die "$self: create new $nailing: $!\n";
print N to_toml($toml) or die "$self: write new $nailing: $!\n";
close N or die "$self: close new $nailing: $!\n";
}
}
our $want_uninstall;
END {
if ($want_uninstall) {
local ($?);
foreach my $mf (keys %manifests) {
eval { uninstall1($mf, 0); 1; } or warn "$@";
}
}
}
sub makebackups () {
foreach my $mf (keys %manifests) {
link "$mf", "$mf.unnailed" or $!==EEXIST
or die "$self: make backup link $mf.unnailed: $!\n";
}
}
sub install () {
foreach my $mf (keys %manifests) {
my $nailing = "$mf.nailing~";
my $nailed = "$mf.nailed~";
my ($use, $rm);
my $diff;
if (open NN, '<', $nailed) {
$diff = compare($nailing, \*NN);
die "$self: compare $nailing and $nailed: $!" if $diff<0;
} else {
$!==ENOENT or die "$self: check previous $nailed: $!\n";
$diff = 1;
}
if ($diff) {
$use = $nailing;
$rm = $nailed;
} else {
$use = $nailed;
$rm = $nailing;
}
rename $use, $mf or die "$self: install nailed $use: $!\n";
unlink $rm or $!==ENOENT or die "$self: remove old $rm: $!\n";
}
}
sub invoke () {
my $r = system @ARGV;
if (!$r) {
return 0;
} elsif ($r<0) {
print STDERR "$self: could not execute $ARGV[0]: $!\n";
return 127;
} elsif ($r & 0xff00) {
print STDERR "$self: $ARGV[0] failed (exit status $r)\n";
return $r >> 8;
} else {
print STDERR "$self: $ARGV[0] died due to signal! (wait status $r)\n";
return 125;
}
}
sub uninstall1 ($$) {
my ($mf, $enoentok) = @_;
my $unnailed = "$mf.unnailed";
rename $unnailed, $mf or ($enoentok && $!==ENOENT)
or die "$self: failed to revert: rename $unnailed back to $mf: $!\n";
}
sub uninstall () {
foreach my $mf (keys %manifests) {
uninstall1($mf,0);
}
}
while (@ARGV && $ARGV[0] =~ m/^-/) {
$_ = shift @ARGV;
last if m/^--$/;
}
takelock();
readnail();
readorigs();
calculate();
$want_uninstall = 1;
makebackups();
install();
my $estatus = invoke();
uninstall();
$want_uninstall = 1;
exit $estatus;
use Data::Dumper;
print STDERR Dumper(\%packagemap, \%manifests);
__DATA__
lock=${PWD%/*}/.nail.lock
if [ "x$NAILING_CARGO" != "x$lock" ]; then
NAILING_CARGO=$lock \
exec with-lock-ex -w "$lock" "$self" "$@"
fi
exec 203<../Cargo.nail
f=Cargo.toml
sed='
/^ *\[\(build-\)\?dependencies\]/,/^ \[/{
'
if test -e ../Cargo.nail-env; then
. ../Cargo.nail-env
fi
exec 204<../Cargo.nail
while read <&204 what where; do
if [ "x$what" = x- ]; then continue; fi
if [ "x$what" = 'x#' ]; then continue; fi
qwhere="${where//\//\\/}"
sed+='
/{.*path *=/ b
s/^'$what' *= *\(\".*\"\) *$/'$what' = { version = \1 }/;
s#^'$what' *= *{#'$what' = { path = "'"${PWD%/*}"'/'"${qwhere}"'", #;
/^'$what' *=/ s/version *= *\"[^"]*\"//;
/^'$what' *=/ s/, *\([,}]\)/\1/;
'
done
sed+='}
'
exec 204<../Cargo.nail
while read <&204 what where; do
if [ "x$what" = 'x#' ]; then continue; fi
wf=../$where/$f
rm -f $wf.nailing~
sed <$wf >$wf.nailing~ "$sed"
done
exec 204<../Cargo.nail
while read <&204 what where; do
if [ "x$what" = 'x#' ]; then continue; fi
wf=../$where/$f
if ! test -e $wf.unnailed~; then
ln $wf $wf.unnailed~
fi
done
trap '
set +e
while read <&203 what where; do
if [ "x$what" = "x#" ]; then continue; fi
wf=../$where/$f
if test -e $wf.unnailed~; then
rm -f $wf.nailed~
ln $wf $wf.nailed~
mv -f $wf.unnailed~ $wf
fi
done
echo >&2 'Unnailed'
' EXIT
exec 204<../Cargo.nail
printf >&2 'Nailing'
while read <&204 what where; do
if [ "x$what" = 'x#' ]; then continue; fi
wf=../$where/$f
printf >&2 ' %s' "$what"
if cmp -s $wf.nailed~ $wf.nailing~; then
mv -f $wf.nailed~ $wf
rm -f $wf.nailing
else
mv -f $wf.nailing~ $wf
rm -f $wf.nailed
fi
done
echo >&2
"$@"