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