nailing-cargo

   1 #!/usr/bin/perl -w
   2
   3 #    nailing-cargo: wrapper to use unpublished local crates
   4 #
   5 #    Copyright (C) 2019-2020 Ian Jackson
   6 #
   7 #    This program is free software: you can redistribute it and/or modify
   8 #    it under the terms of the GNU Affero General Public License as
   9 #    published by the Free Software Foundation, either version 3 of the
  10 #    License, or (at your option) any later version.
  11 #
  12 #    This program is distributed in the hope that it will be useful,
  13 #    but WITHOUT ANY WARRANTY; without even the implied warranty of
  14 #    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  15 #    GNU Affero General Public License for more details.
  16 #
  17 #    You should have received a copy of the GNU Affero General Public License
  18 #    along with this program.  If not, see <http://www.gnu.org/licenses/>.
  19
  20 # example usages:
  21 #   ../nailing-cargo/nailing-caretwgo make
  22 #   ../nailing-cargo/nailing-cargo cargo build
  23 #   CARGO='../nailing-cargo/nailing-cargo cargo' make
  24
  25 # Why do we need this ?
  26 #
  27 #  https://github.com/rust-lang/cargo/issues/6713
  28 #  https://stackoverflow.com/questions/33025887/how-to-use-a-local-unpublished-crate
  29 #  https://github.com/rust-lang/cargo/issues/1481
  30
  31 # Needs libtoml-perl
  32
  33 #: Cargo.nail:
  34 #
  35 #    [packages]
  36 #    package = subdir
  37 #    package = { subdir = ... }
  38 #
  39 #    [subdirs]
  40 #    subdir
  41
  42 use strict;
  43 use TOML;
  44 use POSIX;
  45 use Fcntl qw(LOCK_EX);
  46 use File::Compare;
  47
  48 my $self = $0;  $self =~ s{^.*/(?=.)}{};
  49
  50 our $worksphere = getcwd() // die "$self: getcwd failed: $!\n";
  51 $worksphere =~ s{/[^/]+}{} or die "$self: cwd \`$worksphere' unsupported!\n";
  52 our $lockfile = "../.nailing-cargo-sphere.lock";
  53
  54 our @configs;
  55
  56 sub read_or_enoent ($) {
  57     my ($fn) = @_;
  58     if (!open R, '<', $fn) {
  59         return undef if $!==ENOENT;
  60         die "$self: open $fn: $!\n";
  61     }
  62     local ($/) = undef;
  63     my ($r) = <R> // die "$self: read $fn: $!\n";
  64     $r;
  65 }
  66
  67 sub toml_or_enoent ($$) {
  68     my ($f,$what) = @_;
  69     my $toml = read_or_enoent($f) // return;
  70     my ($v,$e) = from_toml($toml);
  71     die "$self: parse TOML: $what: $f: $e\n" unless defined $v;
  72     die "$e ?" if length $e;
  73     $v;
  74 }
  75
  76 sub load1config ($) {
  77     my ($f) = @_;
  78     my $toml = toml_or_enoent($f, "config file");
  79     push @configs, $toml if defined $toml;
  80 }
  81
  82 sub loadconfigs () {
  83     my $cfgleaf = ".nailing-cargo-cfg.toml";
  84     load1config("/etc/nailing-cargo/cfg.toml");
  85     load1config("$worksphere/$cfgleaf");
  86     load1config("$ENV{HOME}/$cfgleaf") if defined $ENV{HOME};
  87 }
  88
  89 sub getcfg ($$) {
  90     my ($k, $def) = @_;
  91     foreach my $cfg (@configs) {
  92         my $v = $cfg->{$k};
  93         return $v if defined $v;
  94     }
  95     return $def;
  96 }
  97
  98 sub takelock () {
  99     for (;;) {
 100         open LOCK, ">", $lockfile or die "$self: open/create $lockfile: $!\n";
 101         flock LOCK, LOCK_EX or die "$self: lock $lockfile: $!\n";
 102         my @fstat = stat LOCK or die "$self: fstat: $!\n";
 103         my @stat  = stat $lockfile;
 104         if (!@stat) {
 105             next if $! == ENOENT;
 106             die "$self: stat $lockfile: $!\n";
 107         }
 108         last if "@fstat[0..5]" eq "@stat[0..5]";
 109     }
 110 }
 111 sub unlock () {
 112     unlink $lockfile or die "$self: removing lockfile: $!\n";
 113 }
 114
 115 our $nail;
 116
 117 sub readnail () {
 118     my $nailfile = "../Cargo.nail";
 119     open N, '<', $nailfile or die "$self: open $nailfile: $!\n";
 120     local ($/) = undef;
 121     my $toml = <N> // die "$self: read $nailfile: $!";
 122     my $transformed;
 123     if ($toml !~ m{^\s*\[/}m &&
 124         $toml !~ m{^[^\n\#]*\=}m &&
 125         # old non-toml syntax
 126         $toml =~ s{^[ \t]*([-_0-9a-z]+)[ \t]+(\S+)[ \t]*$}{$1 = \"$2\"}mig) {
 127         $toml =~ s{^}{[packages\]\n};
 128         $transformed = 1;
 129     }
 130     my $e;
 131     ($nail,$e) = from_toml($toml);
 132     if (!defined $nail) {
 133         if ($transformed) {
 134             $toml =~ s/^/    /mg;
 135             print STDERR "$self: $nailfile transformed into TOML:\n$toml\n";
 136         }
 137         die "$self: parse $nailfile: $e\n";
 138     }
 139     die "$e ?" if length $e;
 140 }
 141
 142 our %manifests;
 143 our %packagemap;
 144
 145 sub read_manifest ($) {
 146     my ($subdir) = @_;
 147     my $manifest = "../$subdir/Cargo.toml";
 148     if (defined $manifests{$manifest}) {
 149         print STDERR
 150 "$self: warning: $subdir: specified more than once!\n";
 151         return undef;
 152     }
 153     foreach my $try ("$manifest.unnailed", "$manifest") {
 154         my $toml = toml_or_enoent($try, "package manifest") // next;
 155         my $p = $toml->{package}{name};
 156         if (!defined $p) {
 157             print STDERR
 158 "$self: warning: $subdir: missing package.name in $try, ignoring\n";
 159             next;
 160         }
 161         $manifests{$manifest} = $toml;
 162         return $p;
 163     }
 164     return undef;
 165 }
 166
 167 sub readorigs () {
 168     foreach my $p (keys %{ $nail->{packages} }) {
 169         my $v = $nail->{packages}{$p};
 170         my $subdir = ref($v) ? $v->{subdir} : $v;
 171         my $gotpackage = read_manifest($subdir) // '<nothing!>';
 172         if ($gotpackage ne $p) {
 173             print STDERR
 174  "$self: warning: honouring Cargo.nail [packages.$subdir]=$p even though $subdir contains package $gotpackage!\n";
 175         }
 176         die if defined $packagemap{$p};
 177         $packagemap{$p} = $subdir;
 178     }
 179     foreach my $subdir (@{ $nail->{subdirs} }) {
 180         my $gotpackage = read_manifest($subdir);
 181         if (!defined $gotpackage) {
 182             print STDERR
 183  "$self: warning: ignoring subdir $subdir which has no Cargo.toml\n";
 184             next;
 185         }
 186         $packagemap{$gotpackage} //= $subdir;
 187     }
 188 }
 189
 190 sub calculate () {
 191     foreach my $mf (keys %manifests) {
 192         my $toml = $manifests{$mf};
 193         foreach my $k (qw(dependencies build-dependencies dev-dependencies)) {
 194             my $deps = $toml->{$k};
 195             next unless $deps;
 196             foreach my $p (keys %packagemap) {
 197                 my $info = $deps->{$p};
 198                 next unless $info;
 199                 $info = { } unless ref $info;
 200                 delete $info->{version};
 201                 $info->{path} = $packagemap{$p};
 202             }
 203         }
 204         my $nailing = "$mf.nailing~";
 205         unlink $nailing or $!==ENOENT or die "$self: remove old $nailing: $!\n";
 206         open N, '>', $nailing or die "$self: create new $nailing: $!\n";
 207         print N to_toml($toml) or die "$self: write new $nailing: $!\n";
 208         close N or die "$self: close new $nailing: $!\n";
 209     }
 210 }
 211
 212 our $want_uninstall;
 213
 214 END {
 215     if ($want_uninstall) {
 216         local ($?);
 217         foreach my $mf (keys %manifests) {
 218             eval { uninstall1($mf, 0); 1; } or warn "$@";
 219         }
 220     }
 221 }
 222
 223 sub makebackups () {
 224     foreach my $mf (keys %manifests) {
 225         link "$mf", "$mf.unnailed" or $!==EEXIST
 226             or die "$self: make backup link $mf.unnailed: $!\n";
 227     }
 228 }
 229
 230 sub install () {
 231     foreach my $mf (keys %manifests) {
 232         my $nailing = "$mf.nailing~";
 233         my $nailed  = "$mf.nailed~";
 234         my ($use, $rm);
 235         my $diff;
 236         if (open NN, '<', $nailed) {
 237             $diff = compare($nailing, \*NN);
 238             die "$self: compare $nailing and $nailed: $!" if $diff<0;
 239         } else {
 240             $!==ENOENT or die "$self: check previous $nailed: $!\n";
 241             $diff = 1;
 242         }
 243         if ($diff) {
 244             $use = $nailing;
 245             $rm  = $nailed;
 246         } else {
 247             $use = $nailed;
 248             $rm  = $nailing;
 249         }
 250         rename $use, $mf or die "$self: install nailed $use: $!\n";
 251         unlink $rm or $!==ENOENT or die "$self: remove old $rm: $!\n";
 252     }
 253 }
 254
 255 sub invoke () {
 256     my $r = system @ARGV;
 257     if (!$r) {
 258         return 0;
 259     } elsif ($r<0) {
 260         print STDERR "$self: could not execute $ARGV[0]: $!\n";
 261         return 127;
 262     } elsif ($r & 0xff00) {
 263         print STDERR "$self: $ARGV[0] failed (exit status $r)\n";
 264         return $r >> 8;
 265     } else {
 266         print STDERR "$self: $ARGV[0] died due to signal! (wait status $r)\n";
 267         return 125;
 268     }
 269 }
 270
 271 sub uninstall1 ($$) {
 272     my ($mf, $enoentok) = @_;
 273     my $unnailed = "$mf.unnailed";
 274     rename $unnailed, $mf or ($enoentok && $!==ENOENT)
 275         or die "$self: failed to revert: rename $unnailed back to $mf: $!\n";
 276 }
 277
 278 sub uninstall () {
 279     foreach my $mf (keys %manifests) {
 280         uninstall1($mf,0);
 281     }
 282 }
 283
 284 while (@ARGV && $ARGV[0] =~ m/^-/) {
 285     $_ = shift @ARGV;
 286     last if m/^--$/;
 287 }
 288
 289 takelock();
 290 readnail();
 291 readorigs();
 292 calculate();
 293 $want_uninstall = 1;
 294 makebackups();
 295 install();
 296
 297 my $estatus = invoke();
 298
 299 uninstall();
 300 $want_uninstall = 1;
 301
 302 exit $estatus;
 303
 304
 305 use Data::Dumper;
 306 print STDERR Dumper(\%packagemap, \%manifests);
 307
 308 __DATA__
 309
 310 lock=${PWD%/*}/.nail.lock
 311 if [ "x$NAILING_CARGO" != "x$lock" ]; then
 312         NAILING_CARGO=$lock \
 313         exec with-lock-ex -w "$lock" "$self" "$@"
 314 fi
 315
 316 exec 203<../Cargo.nail
 317 f=Cargo.toml
 318
 319 sed='
 320 /^ *\[\(build-\)\?dependencies\]/,/^ \[/{
 321 '
 322
 323 if test -e ../Cargo.nail-env; then
 324         . ../Cargo.nail-env
 325 fi
 326
 327 exec 204<../Cargo.nail
 328 while read <&204 what where; do
 329         if [ "x$what" = x- ]; then continue; fi
 330         if [ "x$what" = 'x#' ]; then continue; fi
 331         qwhere="${where//\//\\/}"
 332         sed+='
 333                 /{.*path *=/ b
 334                 s/^'$what' *= *\(\".*\"\) *$/'$what' = { version = \1 }/;
 335                 s#^'$what' *= *{#'$what' = { path = "'"${PWD%/*}"'/'"${qwhere}"'", #;
 336                 /^'$what' *=/ s/version *= *\"[^"]*\"//;
 337                 /^'$what' *=/ s/, *\([,}]\)/\1/;
 338         '
 339 done
 340 sed+='}
 341 '
 342
 343 exec 204<../Cargo.nail
 344 while read <&204 what where; do
 345         if [ "x$what" = 'x#' ]; then continue; fi
 346         wf=../$where/$f
 347         rm -f $wf.nailing~
 348         sed <$wf >$wf.nailing~ "$sed"
 349 done
 350
 351 exec 204<../Cargo.nail
 352 while read <&204 what where; do
 353         if [ "x$what" = 'x#' ]; then continue; fi
 354         wf=../$where/$f
 355         if ! test -e $wf.unnailed~; then
 356                 ln $wf $wf.unnailed~
 357         fi
 358 done
 359
 360 trap '
 361         set +e
 362         while read <&203 what where; do
 363                 if [ "x$what" = "x#" ]; then continue; fi
 364                 wf=../$where/$f
 365                 if test -e $wf.unnailed~; then
 366                         rm -f $wf.nailed~
 367                         ln $wf $wf.nailed~
 368                         mv -f $wf.unnailed~ $wf
 369                 fi
 370         done
 371         echo >&2 'Unnailed'
 372 ' EXIT
 373
 374 exec 204<../Cargo.nail
 375 printf >&2 'Nailing'
 376 while read <&204 what where; do
 377         if [ "x$what" = 'x#' ]; then continue; fi
 378         wf=../$where/$f
 379         printf >&2 ' %s' "$what"
 380         if cmp -s $wf.nailed~ $wf.nailing~; then
 381                 mv -f $wf.nailed~ $wf
 382                 rm -f $wf.nailing
 383         else
 384                 mv -f $wf.nailing~ $wf
 385                 rm -f $wf.nailed
 386         fi
 387 done
 388 echo >&2
 389
 390 "$@"