nailing-cargo

   1 #!/usr/bin/perl -w
   2 # nailing-cargo: wrapper to use unpublished local crates
   3 # SPDX-License-Identifier: AGPL-3.0-or-later
   4
   5 our $self;
   6
   7 use strict;
   8 use POSIX;
   9 use Types::Serialiser;
  10
  11 our %archmap = (
  12     RPI => 'arm-unknown-linux-gnueabihf',
  13 );
  14
  15 BEGIN {
  16   $self = $0;  $self =~ s{^.*/(?=.)}{};
  17   my $deref = $0;
  18   while ($deref =~ m{^/}) {
  19     my $link = readlink $deref;
  20     if (!defined $link) {
  21       $! == EINVAL
  22         or die "$self: checking our script location $deref: $!\n";
  23       $deref =~ s{/[^/]+$}{}
  24         or die "$self: unexpected script path: $deref\n";
  25       unshift @INC, $deref."/TOML-Tiny/lib";
  26       last;
  27     }
  28     last if $link !~ m{^/};
  29     $deref = $link;
  30   }
  31 }
  32
  33 use Fcntl qw(LOCK_EX);
  34 use File::Compare;
  35 use TOML::Tiny::Faithful;
  36
  37 our $src_absdir = getcwd() // die "$self: getcwd failed: $!\n";
  38
  39 our $worksphere = $src_absdir;
  40 $worksphere =~ s{/([^/]+)$}{}
  41   or die "$self: cwd \`$worksphere' unsupported!\n";e
  42 our $subdir = $1; # leafname
  43
  44 our $lockfile = "../.nailing-cargo.lock";
  45
  46 our $cargo_subcmd;
  47 our $command_is_cargo;
  48 our $alt_cargo_lock;
  49 our $online;
  50
  51 #
  52 our %subcmd_props = {
  53 # build (default)  =>qw(                                        ),
  54  update            =>qw( lock-update !target                    ),
  55 'generate-lockfile'=>qw( lock-update !target                    ),
  56  fetch             =>qw(             !target online !target-dir ),
  57                     };
  58
  59 our @subcmd_xprops = qw(!manifest-path !offline !locked);
  60
  61 our @configs;
  62 our $verbose=1;
  63 our ($noact,$dump);
  64 our $target;
  65
  66 sub read_or_enoent ($) {
  67   my ($fn) = @_;
  68   if (!open R, '<', $fn) {
  69     return undef if $!==ENOENT;
  70     die "$self: open $fn: $!\n";
  71   }
  72   local ($/) = undef;
  73   my ($r) = <R> // die "$self: read $fn: $!\n";
  74   $r;
  75 }
  76
  77 sub stat_exists ($$) {
  78   my ($fn, $what) = @_;
  79   if (stat $fn) { return 1; }
  80   $!==ENOENT or die "$self: stat $what: $fn: $!\n";
  81   return 0;
  82 }
  83
  84 sub toml_or_enoent ($$) {
  85   my ($f,$what) = @_;
  86   my $toml = read_or_enoent($f) // return;
  87   print STDERR "Read TOML from $f\n" if $dump;
  88   my ($v,$e) = from_toml($toml);
  89   if (!defined $v) {
  90     chomp $e;
  91     die "$self: parse TOML: $what: $f: $e\n";
  92   }
  93   die "$e ?" if length $e;
  94   $v;
  95 }
  96
  97 sub load1config ($) {
  98   my ($f) = @_;
  99   my $toml = toml_or_enoent($f, "config file");
 100   push @configs, $toml if defined $toml;
 101 }
 102
 103 sub loadconfigs () {
 104   my $dotfile = ".nailing-cargo.toml";
 105   load1config("../Nailing-Cargo.toml");
 106   load1config($dotfile);
 107   load1config("$ENV{HOME}/$dotfile") if defined $ENV{HOME};
 108   load1config("/etc/nailing-cargo/cfg.toml");
 109 }
 110
 111 sub unlink_or_enoent ($) { unlink $_[0] or $!==ENOENT; }
 112
 113 sub same_file ($$) {
 114   my ($x,$y) = @_;
 115   "@$x[0..5]" eq "@$y[0..5]";
 116 }
 117
 118 sub takelock () {
 119   for (;;) {
 120     open LOCK, ">", $lockfile or die "$self: open/create $lockfile: $!\n";
 121     flock LOCK, LOCK_EX or die "$self: lock $lockfile: $!\n";
 122     my @fstat = stat LOCK or die "$self: fstat: $!\n";
 123     my @stat  = stat $lockfile;
 124     if (!@stat) {
 125       next if $! == ENOENT;
 126       die "$self: stat $lockfile: $!\n";
 127     }
 128     last if same_file(\@fstat,\@stat);
 129   }
 130 }
 131 sub unlock () {
 132   unlink $lockfile or die "$self: removing lockfile: $!\n";
 133 }
 134
 135 our $nail;
 136
 137 sub badcfg {
 138   my $m = pop @_;
 139   $" = '.';
 140   die "$self: config key \`@_': $m\n";
 141 }
 142
 143 sub cfg_uc {
 144   foreach my $cfg (@configs) {
 145     my $v = $cfg;
 146     foreach my $k (@_) {
 147       last unless defined $v;
 148       ref($v) eq 'HASH' or badcfg @_, "parent key \`$k' is not a hash";
 149       $v = $v->{$k};
 150     }
 151     return $v if defined $v;
 152   }
 153   return undef;
 154 }
 155
 156 sub cfge {
 157   my $exp = shift @_;
 158   my $v = cfg_uc @_;
 159   my $got = ref($v) || 'scalar';
 160   return $v if !defined($v) || $got eq $exp;
 161   badcfg @_, "found \L$got\E, expected \L$exp\E";
 162   # ^ toml doesn't make refs to scalars, so this is unambiguous
 163 }
 164
 165 sub cfgn {
 166   my $exp = shift @_;
 167   (cfge $exp, @_) // badcfg @_, "missing";
 168 }
 169
 170 sub cfgs  { cfge 'scalar', @_ }
 171 sub cfgsn { cfgn 'scalar', @_ }
 172
 173 sub cfg_bool {
 174   my $v = cfg_uc @_;
 175   return $v if !defined($v) || Types::Serialiser::is_bool $v;
 176   badcfg @_, "expected boolean";
 177 }
 178
 179 sub cfgn_list {
 180   my $l = cfge 'ARRAY', @_;
 181   foreach my $x (@$l) {
 182     !ref $x or badcfg @_, "list contains non-scalar element";
 183   }
 184   @$l
 185 }
 186
 187 sub readnail () {
 188   my $nailfile = "../Cargo.nail";
 189   open N, '<', $nailfile or die "$self: open $nailfile: $!\n";
 190   local ($/) = undef;
 191   my $toml = <N> // die "$self: read $nailfile: $!";
 192   my $transformed;
 193   if ($toml !~ m{^\s*\[/}m &&
 194       $toml !~ m{^[^\n\#]*\=}m &&
 195       # old non-toml syntax
 196       $toml =~ s{^[ \t]*([-_0-9a-z]+)[ \t]+(\S+)[ \t]*$}{$1 = \"$2\"}mig) {
 197     $toml =~ s{^}{[packages\]\n};
 198     my @sd;
 199     $toml =~ s{^[ \t]*\-[ \t]*\=[ \t]*(\"[-_0-9a-z]+\"\n?)$}{
 200       push @sd, $1; '';
 201     }mige;
 202     $toml = "subdirs = [\n".(join '', map { "$_\n" } @sd)."]\n".$toml;
 203     $transformed = 1;
 204   }
 205   my $e;
 206   ($nail,$e) = from_toml($toml);
 207   if (!defined $nail) {
 208     if ($transformed) {
 209       $toml =~ s/^/    /mg;
 210       print STDERR "$self: $nailfile transformed into TOML:\n$toml\n";
 211     }
 212     $/="\n"; chomp $e;
 213     die "$self: parse $nailfile: $e\n";
 214   }
 215   die "$e ?" if length $e;
 216
 217   $nail->{subdirs} //= [ ];
 218
 219   if (!ref $nail->{subdirs}) {
 220     $nail->{subdirs} = [
 221       grep /^[^\#]/,
 222       map { s/^\s+//; s/\s+$//; $_; }
 223       split m{\n},
 224       $nail->{subdirs}
 225     ];
 226   }
 227
 228   unshift @configs, $nail;
 229 }
 230
 231 our @alt_cargo_lock_stat;
 232
 233 sub consider_alt_cargo_lock () {
 234   my @ck = qw(alt_cargo_lock);
 235   # User should *either* have Cargo.lock in .gitignore,
 236   # or expect to commit Cargo.lock.example ($alt_cargo_lock)
 237
 238   $alt_cargo_lock = (cfg_uc @ck);
 239
 240   my $force = 0;
 241   if (defined($alt_cargo_lock) && ref($alt_cargo_lock) eq 'HASH') {
 242     $force = cfg_bool qw(alt_cargo_lock force);
 243     my @ck = qw(alt_cargo_lock file);
 244     $alt_cargo_lock = cfg_uc @ck;
 245   }
 246   $alt_cargo_lock //= Types::Serialiser::true;
 247
 248   if (Types::Serialiser::is_bool $alt_cargo_lock) {
 249     if (!$alt_cargo_lock) { $alt_cargo_lock = undef; return; }
 250     $alt_cargo_lock = 'Cargo.lock.example';
 251   }
 252
 253   if (ref($alt_cargo_lock) || $alt_cargo_lock =~ m{/}) {
 254     badcfg @ck, "expected boolean, or leafname";
 255   }
 256
 257   if (!stat_exists $alt_cargo_lock, "alt_cargo_lock") {
 258     $alt_cargo_lock = undef unless $force;
 259     return;
 260   }
 261
 262   @alt_cargo_lock_stat = stat _;
 263 }
 264
 265 our $oot_dir;      # oot.dir or "Build"
 266
 267 sub consider_oot () {
 268   $oot_dir = cfgs qw(oot dir);
 269   my $use = cfgs qw(oot use);
 270   unless (defined($oot_dir) || defined($use)) {
 271     die "$self: specified --cargo-lock-update but not out-of-tree build!\n"
 272       if $cargo_lock_update;
 273     $cargo_lock_update=0;
 274     return;
 275   }
 276   if ($use eq 'disable') {
 277     $oot_dir = undef;
 278     return;
 279   }
 280   $oot_dir //= 'Build';
 281 }
 282
 283 our %manifests;
 284 our %packagemap;
 285
 286 sub read_manifest ($) {
 287   my ($subdir) = @_;
 288   my $manifest = "../$subdir/Cargo.toml";
 289   print STDERR "$self: reading $manifest...\n" if $verbose>=4;
 290   if (defined $manifests{$manifest}) {
 291     print STDERR
 292  "$self: warning: $subdir: specified more than once!\n";
 293     return undef;
 294   }
 295   foreach my $try ("$manifest.unnailed", "$manifest") {
 296     my $toml = toml_or_enoent($try, "package manifest") // next;
 297     my $p = $toml->{package}{name};
 298     if (!defined $p) {
 299       print STDERR
 300  "$self: warning: $subdir: missing package.name in $try, ignoring\n";
 301       next;
 302     }
 303     $manifests{$manifest} = $toml;
 304     return $p;
 305   }
 306   return undef;
 307 }
 308
 309 sub readorigs () {
 310   foreach my $p (keys %{ $nail->{packages} }) {
 311     my $v = $nail->{packages}{$p};
 312     my $subdir = ref($v) ? $v->{subdir} : $v;
 313     my $gotpackage = read_manifest($subdir) // '<nothing!>';
 314     if ($gotpackage ne $p) {
 315       print STDERR
 316  "$self: warning: honouring Cargo.nail packages.$subdir=$p even though $subdir contains package $gotpackage!\n";
 317     }
 318     die if defined $packagemap{$p};
 319     $packagemap{$p} = $subdir;
 320   }
 321   foreach my $subdir (@{ $nail->{subdirs} }) {
 322     my $gotpackage = read_manifest($subdir);
 323     if (!defined $gotpackage) {
 324       print STDERR
 325  "$self: warning: ignoring subdir $subdir which has no Cargo.toml\n";
 326       next;
 327     }
 328     $packagemap{$gotpackage} //= $subdir;
 329   }
 330 }
 331
 332 sub calculate () {
 333   foreach my $p (sort keys %packagemap) {
 334     print STDERR "$self: package $p in $packagemap{$p}\n" if $verbose>=2;
 335   }
 336   foreach my $mf (keys %manifests) {
 337     my $toml = $manifests{$mf};
 338     foreach my $k (qw(dependencies build-dependencies dev-dependencies)) {
 339       my $deps = $toml->{$k};
 340       next unless $deps;
 341       foreach my $p (keys %packagemap) {
 342         my $info = $deps->{$p};
 343         next unless defined $info;
 344         $deps->{$p} = $info = { } unless ref $info;
 345         delete $info->{version};
 346         $info->{path} = $worksphere.'/'.$packagemap{$p};
 347       }
 348     }
 349     my $nailing = "$mf.nailing~";
 350     unlink_or_enoent $nailing or die "$self: remove old $nailing: $!\n";
 351     open N, '>', $nailing or die "$self: create new $nailing: $!\n";
 352     print N to_toml($toml) or die "$self: write new $nailing: $!\n";
 353     close N or die "$self: close new $nailing: $!\n";
 354   }
 355 }
 356
 357 sub addargs () {
 358   $online = 1 if subcmd_p('online');
 359   $online //= cfg_bool qw(misc online);
 360   $online //= 0;
 361
 362   $cargo_lock_update //= subcmd_p('lock-update');
 363
 364   our @add;
 365
 366   if (!$cargo_lock_update) {
 367     push @add, qw(--locked) unless subcmd_p('!locked');
 368     if (defined($oot_dir) && !subcmd_p('!manifest-path')) {
 369       push @ARGV, "--manifest-path=${src_absdir}/Cargo.toml" if $pass_options;
 370       push @add, qw(--target-dir=target) unless subcmd_p('!target');
 371     }
 372   }
 373
 374   if (defined($target) && !subcmd_p('!target')) {
 375     if ($target =~ m{^[A-Z]}) {
 376       $target = (cfgs 'arch', $target) // $archmap{$target}
 377         // die "$self: --target=$target alias specified; not in cfg or map\n";
 378     }
 379     push @add, "--target=$target";
 380   }
 381
 382   push @add, "--offline" unless $online || subcmd_p('!offline');
 383
 384   push @ARGV, @add if $pass_options;
 385   die if grep { m/ / } @add;
 386   $ENV{NAILINGCARGO_CARGO_OPTIONS} = "@add";
 387 }
 388
 389 our $oot_absdir;
 390 our $build_absdir; # .../Build/<subdir>
 391
 392 sub oot_massage_cmdline () {
 393   return unless defined $oot_dir;
 394
 395   my $use = cfgs qw(oot use);
 396   $oot_absdir = ($oot_dir !~ m{^/} ? "$worksphere/" : ""). $oot_dir;
 397   $build_absdir = "$oot_absdir/$subdir";
 398
 399   my ($pre,$post);
 400   my @xargs;
 401   if (!$cargo_lock_update) {
 402     push @xargs, $build_absdir;
 403     ($pre, $post) = ('cd "$1"; shift; ', '');
 404   } else {
 405     push @xargs, $oot_absdir, $subdir, $src_absdir;
 406     $pre =  <<'END';
 407         cd "$1"; shift;
 408         mkdir -p -- "$1"; cd "$1"; shift;
 409         cp -- "$1"/Cargo.toml
 410 END
 411     $pre .= <<'ENDLK' if stat_exists 'Cargo.lock', 'working cargo lockfile';
 412               "$1"/Cargo.lock
 413 ENDLK
 414     $pre .= <<'ENDCP';
 415                               .;
 416 ENDCP
 417     $pre .= <<'ENDPRE';
 418         shift;
 419         mkdir -p src; >src/lib.rs; >build.rs
 420 ENDPRE
 421     $post = <<'ENDPOST';
 422         rm -r src Cargo.toml build.rs;
 423 ENDPOST
 424   }
 425   my $addpath = (cfg_uc qw(oot path_add)) //
 426     $use eq 'really' ? Types::Serialiser::true : Types::Serialiser::false;
 427   $addpath =
 428     !Types::Serialiser::is_bool $addpath ? $addpath           :
 429     $addpath                             ? '$HOME/.cargo/bin' :
 430                                            undef;
 431   if (defined $addpath) {
 432     $pre .= <<END
 433         PATH=$addpath:\${PATH-/usr/local/bin:/bin:/usr/bin};
 434         export PATH;
 435 END
 436   }
 437   $pre  =~ s/^\s+//mg; $pre  =~ s/\s+/ /g;
 438   $post =~ s/^\s+//mg; $post =~ s/\s+/ /g;
 439
 440   my $getuser = sub { cfgsn qw(oot user) };
 441   my @command;
 442   my $xe = $verbose >= 2 ? 'xe' : 'e';
 443   my $sh_ec = sub {
 444     if (!length $post) {
 445       @command = (@_, 'sh',"-${xe}c",$pre.'exec "$@"','--',@xargs);
 446     } else {
 447       @command = (@_, 'sh',"-${xe}c",$pre.'"$@"; '.$post,'--',@xargs);
 448     }
 449     push @command, @ARGV;
 450   };
 451   my $command_sh = sub {
 452     my $quoted = join ' ', map {
 453       return $_ if !m/\W/;
 454       s/\'/\'\\'\'/g;
 455       "'$_'"
 456     } @ARGV;
 457     @command = @_, "set -${xe}; $pre $quoted; $post";
 458   };
 459   print STDERR "$self: out-of-tree, building in: \`$build_absdir'\n"
 460     if $verbose;
 461   if ($use eq 'really') {
 462     my $user = $getuser->();
 463     my @pw = getpwnam $user or die "$self: oot.user \`$user' lookup failed\n";
 464     my $homedir = $pw[7];
 465     $sh_ec->('really','-u',$user,'env',"HOME=$homedir");
 466     print STDERR "$self: using really to run as user \`$user'\n" if $verbose;
 467   } elsif ($use eq 'ssh') {
 468     my $user = $getuser->();
 469     $user .= '@localhost' unless $user =~ m/\@/;
 470     $command_sh->('ssh',$user);
 471     print STDERR "$self: using ssh to run as \`$user'\n" if $verbose;
 472   } elsif ($use eq 'command_args') {
 473     my @c = cfgn_list qw(oot command);
 474     $sh_ec->(@c);
 475     print STDERR "$self: out-of-tree, adverbial command: @c\n" if $verbose;
 476   } elsif ($use eq 'command_sh') {
 477     my @c = cfgn_list qw(oot command);
 478     $command_sh->(@c);
 479     print STDERR "$self: out-of-tree, ssh'ish command: @c\n" if $verbose;
 480   } elsif ($use eq 'null') {
 481     $sh_ec->();
 482   } else {
 483     die "$self: oot.use mode $use not recognised\n";
 484   }
 485   die unless @command;
 486   @ARGV = @command;
 487 }
 488
 489 sub setenvs () {
 490   $ENV{CARGO_MANIFEST_DIR} = $src_absdir;
 491   $ENV{NAILINGCARGO_MANIFEST_DIR} = $src_absdir;
 492   $ENV{NAILINGCARGO_WORKSPHERE}   = $worksphere;
 493   $ENV{NAILINGCARGO_BUILDSPHERE}  = $oot_absdir;
 494   delete $ENV{NAILINGCARGO_BUILDSPHERE} unless $oot_absdir;
 495   $ENV{NAILINGCARGO_BUILD_DIR}    = $build_absdir // $src_absdir;
 496 }
 497
 498 our $want_uninstall;
 499
 500 END {
 501   if ($want_uninstall) {
 502     local ($?);
 503     foreach my $mf (keys %manifests) {
 504       eval { uninstall1($mf,1); 1; } or warn "$@";
 505     }
 506     eval { unaltcargolock(1); 1; } or warn "$@";
 507   }
 508 }
 509
 510 our $cleanup_cargo_lock;
 511 sub makebackups () {
 512   foreach my $mf (keys %manifests) {
 513     link "$mf", "$mf.unnailed" or $!==EEXIST
 514       or die "$self: make backup link $mf.unnailed: $!\n";
 515   }
 516
 517   if (defined($alt_cargo_lock)) {
 518     if (@alt_cargo_lock_stat) {
 519       print STDERR "$self: using alt_cargo_lock `$alt_cargo_lock'..."
 520         if $verbose>=3;
 521       if (link $alt_cargo_lock, 'Cargo.lock') {
 522         print STDERR " linked\n" if $verbose>=3;
 523       } elsif ($! != EEXIST) {
 524         print STDERR "\n" if $verbose>=3;
 525         die "$self: make \`Cargo.lock' available as \`$alt_cargo_lock': $!\n";
 526       } else {
 527         print STDERR "checking quality." if $verbose>=3;
 528         my @lock_stat = stat 'Cargo.lock'
 529           or die "$self: stat Cargo.lock (for alt check: $!\n";
 530         same_file(\@alt_cargo_lock_stat, \@lock_stat)
 531           or die
 532 "$self: \`Cargo.lock' and alt file \`$alt_cargo_lock' both exist and are not the same file!\n";
 533       }
 534       $cleanup_cargo_lock = 1;
 535     } else {
 536       $cleanup_cargo_lock = 1;
 537       # If Cargo.lock exists and alt doesn't, that means either
 538       # that a previous run was interrupted, or that the user has
 539       # messed up.
 540     }
 541   }
 542 }
 543
 544 sub nailed ($) {
 545   my ($mf) = @_;
 546   my $nailed  = "$mf.nailed~"; $nailed =~ s{/([^/]+)$}{/.$1} or die;
 547   $nailed;
 548 }
 549
 550 sub install () {
 551   my @our_unfound_stab = stat_exists('Cargo.toml', 'local Cargo.toml')
 552     ? (stat _) : ();
 553   foreach my $mf (keys %manifests) {
 554     if (@our_unfound_stab) {
 555       if (stat_exists $mf, "manifest in to-be-nailed directory") {
 556         my @mf_stab = stat _ ;
 557         if ("@mf_stab[0..1]" eq "@our_unfound_stab[0..1]") {
 558           @our_unfound_stab = ();
 559         }
 560       }
 561     }
 562
 563     my $nailing = "$mf.nailing~";
 564     my $nailed = nailed($mf);
 565     my ($use, $rm);
 566     my $diff;
 567     if (open NN, '<', $nailed) {
 568       $diff = compare($nailing, \*NN);
 569       die "$self: compare $nailing and $nailed: $!" if $diff<0;
 570     } else {
 571       $!==ENOENT or die "$self: check previous $nailed: $!\n";
 572       $diff = 1;
 573     }
 574     if ($diff) {
 575       $use = $nailing;
 576       $rm  = $nailed;
 577     } else {
 578       $use = $nailed;
 579       $rm  = $nailing;
 580     }
 581     rename $use, $mf or die "$self: install nailed $use: $!\n";
 582     unlink_or_enoent $rm or die "$self: remove old $rm: $!\n";
 583     print STDERR "$self: nailed $mf\n" if $verbose>=3;
 584   }
 585
 586   if (@our_unfound_stab) {
 587     print STDERR
 588  "$self: *WARNING* cwd is not in Cargo.nail thbough it has Cargo.toml!\n";
 589   }
 590 }
 591
 592 sub invoke () {
 593   my $r = system @ARGV;
 594   if (!$r) {
 595     return 0;
 596   } elsif ($r<0) {
 597     print STDERR "$self: could not execute $ARGV[0]: $!\n";
 598     return 127;
 599   } elsif ($r & 0xff00) {
 600     print STDERR "$self: $ARGV[0] failed (exit status $r)\n";
 601     return $r >> 8;
 602   } else {
 603     print STDERR "$self: $ARGV[0] died due to signal! (wait status $r)\n";
 604     return 125;
 605   }
 606 }
 607
 608 sub cargo_lock_update_after () {
 609   if ($cargo_lock_update) {
 610     # avoids importing File::Copy and the error handling is about as good
 611     $!=0; $?=0;
 612     my $r= system qw(cp --), "$build_absdir/Cargo.lock", "Cargo.lock";
 613     die "$self: run cp: $! $?" if $r<0 || $r & 0xff;
 614     die "$self: failed to update local Cargo.lock (wait status $r)\n" if $r;
 615   }
 616 }
 617
 618 sub uninstall1 ($$) {
 619   my ($mf, $enoentok) = @_;
 620   my $unnailed = "$mf.unnailed";
 621   rename $unnailed, $mf or ($enoentok && $!==ENOENT)
 622     or die "$self: failed to restore: rename $unnailed back to $mf: $!\n";
 623 }
 624
 625 sub unaltcargolock ($) {
 626   my ($enoentok) = @_;
 627   return unless $cleanup_cargo_lock;
 628   die 'internal error!' unless defined $alt_cargo_lock;
 629
 630   # we ignore $enoentok because we don't know if one was supposed to
 631   # have been created.
 632
 633   rename('Cargo.lock', $alt_cargo_lock) or $!==ENOENT or die
 634  "$self: cleanup: rename possibly-updated \`Cargo.lock' to \`$alt_cargo_lock': $!\n";
 635
 636   unlink 'Cargo.lock' or $!==ENOENT or die
 637  "$self: cleanup: remove \`Cargo.lock' in favour of \`$alt_cargo_lock': $!\n";
 638   # ^ this also helps clean up the stupid rename() corner case
 639 }
 640
 641 sub uninstall () {
 642   foreach my $mf (keys %manifests) {
 643     my $nailed = nailed($mf);
 644     link $mf, $nailed or die "$self: preserve (link) $mf as $nailed: $!\n";
 645     uninstall1($mf,0);
 646   }
 647   unaltcargolock(0);
 648 }
 649
 650 sub parse_args () {
 651   my $is_cargo;
 652
 653   # Loop exit condition:
 654   #   $is_cargo is set
 655   #   @ARGV contains
 656   #    $is_cargo==1   <cargo-command> <cargo-opts> [--] <subcmd>...
 657   #    $is_cargo==0   <build-command>...
 658
 659   for (;;) {
 660     @ARGV or die "$self: need cargo subcommand\n";
 661
 662     $_ = shift @ARGV;
 663     my $orgopt = $_;
 664
 665     my $not_a_nailing_opt = sub { # usage 1
 666       unshift @ARGV, $orgopt;
 667       unshift @ARGV, 'cargo';
 668       $is_cargo = 1;
 669       no warnings qw(exiting);
 670       last;
 671     };
 672     $not_a_nailing_opt->() unless m{^-};
 673     $not_a_nailing_opt->() if $_ eq '--';
 674
 675     if ($_ eq '---') { # usage 2 or 3
 676       die "$self: --- must be followed by build command\n" unless @ARGV;
 677       if ($ARGV[0] eq '--') { # usage 3
 678         shift;
 679         $is_cargo = 0;
 680       } elsif (grep { $_ eq '--' } @ARGV) { # usage 2
 681         $is_cargo = 1;
 682       } elsif ($ARGV[0] =~ m{[^/]*cargo[^/]*$}) { # usage 2
 683         $is_cargo = 1;
 684       } else {  # usage 3
 685         $is_cargo = 0;
 686       }
 687       last;
 688     }
 689     if (m{^-[^-]}) {
 690       while (m{^-.}) {
 691         if (s{^-v}{-}) {
 692           $verbose++;
 693         } elsif (s{^-q}{-}) {
 694           $verbose=0;
 695         } elsif (s{^-n}{-}) {
 696           $noact++;
 697         } elsif (s{^-s(.+)}{-}s) {
 698           $cargo_subcmd = $1;
 699         } elsif (s{^-([cC])}{-}) {
 700           $pass_options = $1=~m/[a-z]/;
 701         } elsif (s{^-D}{-}) {
 702           $dump++;
 703         } elsif (s{^-T(.+)}{-}s) {
 704           $target = $1;
 705         } elsif (s{^-([oO])}{-}) {
 706           $online = $1=~m/[a-z]/;
 707         } else {
 708           die "$self: unknown short option(s) $_\n" unless $_ eq $orgopt;
 709           $not_a_nailing_opt->();
 710         }
 711       }
 712     } elsif (s{^--target=}{}) {
 713       $target = $_;
 714     } elsif (m{^--(on|off)line$}) {
 715       $online = $1 eq 'on';
 716     } elsif (s{^--subcommand-props=}{}) {
 717       my @props = split /\,/, $_;
 718       our %subcmd_prop_ok;
 719       if (!%subcmd_prop_ok) {
 720         for $v in (\@subcmd_xprops, values %subcmd_props) {
 721           $subcmd_prop_ok{$_}=1 foreach @$v;
 722         };
 723       }
 724       $subcmd_prop_ok{$_}
 725         or die "$self: unknown subcommand property \`$_'\n"
 726         foreach @props;
 727       $cargo_subcmd = \@props;
 728     } elsif (m{^--(no-)?cargo-lock-update}) {
 729       $cargo_lock_update= !!$1;
 730     } else {
 731       $not_a_nailing_opt->();
 732     }
 733   }
 734
 735   $is_cargo // die;
 736   @ARGV || die;
 737
 738   if ($is_cargo) {
 739     my @cargo_and_opts = shift @ARGV;
 740     while (defined($_ = shift @ARGV)) {
 741       if (!m{^-}) { unshift @ARGV, $_; last; }
 742       if ($_ eq '--') { last; }
 743       push @cargo_and_opts, $_;
 744     }
 745     @ARGV || die "$self: need cargo subcommand\n";
 746     $cargo_subcmd //= $ARGV[0];
 747     $pass_options //= 1;
 748     unshift @ARGV, @cargo_and_opts;
 749   } else {
 750     $cargo_subcmd //= '';
 751     $pass_options //= 0;
 752   }
 753
 754   if (!ref($cargo_subcmd)) {
 755     $cargo_subcmd = $subcmd_props{$cargo_subcmd} // [ ];
 756   }
 757 }
 758
 759 parse_args();
 760 loadconfigs();
 761 takelock();
 762 readnail();
 763 consider_alt_cargo_lock();
 764 consider_oot();
 765 readorigs();
 766 calculate();
 767 addargs();
 768 our @display_cmd = @ARGV;
 769 oot_massage_cmdline();
 770 setenvs();
 771
 772 if ($dump) {
 773   eval '
 774     use Data::Dumper;
 775     print STDERR Dumper(\%manifests) if $dump>=2;
 776     print STDERR Dumper(\%packagemap, \@ARGV,
 777                         { src_absdir => $src_absdir,
 778                           worksphere => $worksphere,
 779                           subdir => $subdir,
 780                           oot_dir => $oot_dir,
 781                           oot_absdir => $oot_absdir,
 782                           build_absdir => $build_absdir });
 783   ' or die $@;
 784 }
 785
 786 exit 0 if $noact;
 787
 788 $want_uninstall = 1;
 789 makebackups();
 790 install();
 791
 792 printf STDERR "$self: nailed (%s manifests, %s packages)%s\n",
 793   (scalar keys %manifests), (scalar keys %packagemap),
 794   (defined($alt_cargo_lock) and ", using `$alt_cargo_lock'")
 795   if $verbose;
 796
 797 print STDERR "$self: invoking: @display_cmd\n" if $verbose;
 798 my $estatus = invoke();
 799
 800 cargo_lock_update_after();
 801
 802 uninstall();
 803 $want_uninstall = 0;
 804
 805 print STDERR "$self: unnailed.  status $estatus.\n" if $verbose;
 806
 807 exit $estatus;