chiark / gitweb /
nailing-cargo: wip, bugfixes
authorIan Jackson <ijackson@chiark.greenend.org.uk>
Sun, 10 May 2020 16:30:01 +0000 (17:30 +0100)
committerIan Jackson <ijackson@chiark.greenend.org.uk>
Sun, 10 May 2020 16:30:01 +0000 (17:30 +0100)
Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
nailing-cargo

index e25b3c671d50c85f009aedb4bd43a6e09db5bba3..c9efaaf9f7781665e9127e3a0b8cb57a07f785e6 100755 (executable)
@@ -95,7 +95,10 @@ 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;
+  if (!defined $v) {
+    chomp $e;
+    die "$self: parse TOML: $what: $f: $e\n";
+  }
   die "$e ?" if length $e;
   $v;
 }
@@ -153,7 +156,7 @@ sub cfg_uc {
   my $v = $nail;
   foreach my $k (@_) {
     last unless defined $v;
-    ref($v) eq 'HASH' or badcfg @, "parent key \`$k' is not a hash";
+    ref($v) eq 'HASH' or badcfg @_, "parent key \`$k' is not a hash";
     $v = $v->{$k};
   }
   return $v;
@@ -170,7 +173,7 @@ sub cfg {
 
 sub cfgn {
   my $exp = shift @_;
-  cfg $exp, @_ // badcfg @_, "missing";
+  (cfg $exp, @_) // badcfg @_, "missing";
 }
 
 sub cfgs  { cfg  'scalar', @_ }
@@ -178,7 +181,7 @@ sub cfgsn { cfgn 'scalar', @_ }
 
 sub cfgn_list {
   my $l = cfg 'ARRAY', @_;
-  foreach my $x (@l) {
+  foreach my $x (@$l) {
     !ref $x or badcfg @_, "list contains non-scalar element";
   }
   @$l
@@ -209,6 +212,7 @@ sub readnail () {
       $toml =~ s/^/    /mg;
       print STDERR "$self: $nailfile transformed into TOML:\n$toml\n";
     }
+    $/="\n"; chomp $e;
     die "$self: parse $nailfile: $e\n";
   }
   die "$e ?" if length $e;
@@ -314,16 +318,16 @@ sub calculate_oot () {
     $oot_cargo_lock_faff = 1;
   }
 
-  $oot_absdir = ($oot_dir !~ m{^/} ? "$worksphere/"). $oot_dir;
+  $oot_absdir = ($oot_dir !~ m{^/} ? "$worksphere/" : ""). $oot_dir;
   $build_absdir = "$oot_absdir/$subdir";
 
   my ($pre,$post);
   my @xargs;
   if (!$oot_cargo_lock_faff) {
-    @xargs = $build_absdir;
-    ($pre, $post) = ('cd "$1"; shift', '');
+    push @xargs, $build_absdir;
+    ($pre, $post) = ('cd "$1"; shift;', '');
   } else {
-    @xargs = $build_absdir, $subdir, $src_absdir;
+    push @xargs, $build_absdir, $subdir, $src_absdir;
     ($pre, $post) = (<<'END', <<'END');
         cd "$1"; shift;
         mkdir -p -- "$1"; cd "$1"; shift;
@@ -337,12 +341,14 @@ END
   }
   my $getuser = sub { cfgsn qw(oot user) };
   my @command;
+  my $xe = $verbose >= 2 ? 'xe' : 'e';
   my $sh_ec = sub {
     if (!length $post) {
-      @command = @_, 'sh','-ec',$pre.' exec "$@"','--',@xargs;
+      @command = (@_, 'sh',"-${xe}c",$pre.' exec "$@"','--',@xargs);
     } else {
-      @command = @_, 'sh','-ec',$pre.' "$@"; '.$post,'--',@xargs;
+      @command = (@_, 'sh',"-${xe}c",$pre.' "$@"; '.$post,'--',@xargs);
     }
+    push @command, @ARGV;
   };
   my $command_sh = sub {
     my $quoted = join ' ', map {
@@ -350,11 +356,11 @@ END
       s/\'/\'\\'\'/g;
       "'$_'"
     } @ARGV;
-    @command = @_, "set -e; $pre $quoted; $post";
+    @command = @_, "set -${xe}; $pre $quoted; $post";
   };
   if ($use eq 'really') {
     my $user = $getuser->();
-    my @pw = getpwnam $user or "die $self: oot.user lookup failed\n";
+    my @pw = getpwnam $user or die "$self: oot.user \`$user' lookup failed\n";
     my $homedir = $pw[7];
     $sh_ec->('really','-u',$user,'env',"HOME=$homedir");
   } elsif ($use eq 'ssh') {