fix debugprefix

[dgit.git] / dgit

diff --git a/dgit b/dgit
index b6d815870165667d72513da46194b0dea42c2dfc..e12bfdc86b6b0d78a647110388a407d41b1bdba1 100755 (executable)
--- a/dgit
+++ b/dgit
@@ -38,7 +38,7 @@ our $package;
 our @ropts;
 
 our $sign = 1;
-our $dryrun = 0;
+our $dryrun_level = 0;
 our $changesfile;
 our $new_package = 0;
 our $ignoredirty = 0;
@@ -46,6 +46,7 @@ our $noquilt = 0;
 our $existing_package = 'dpkg';
 our $cleanmode = 'dpkg-source';
 our $we_are_responder;
+our $initiator_tempdir;
 
 our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
 
@@ -83,6 +84,8 @@ our $keyid;
 our $debug = 0;
 open DEBUG, ">/dev/null" or die $!;
 
+autoflush STDOUT 1;
+
 our $remotename = 'dgit';
 our @ourdscfield = qw(Dgit Vcs-Dgit-Master);
 our $branchprefix = 'dgit';
@@ -113,7 +116,7 @@ sub dscfn ($) {
 sub changesopts () { return @changesopts[1..$#changesopts]; }
 
 our $us = 'dgit';
-our $debugprefix = ' ';
+our $debugprefix = '';
 
 sub printdebug { print DEBUG $debugprefix, @_ or die $!; }
 
@@ -131,6 +134,12 @@ sub fetchspec () {
     return  "+".rrref().":".lrref();
 }
 
+sub changedir ($) {
+    my ($newdir) = @_;
+    printdebug "CD $newdir\n";
+    chdir $newdir or die "chdir: $newdir: $!";
+}
+
 #---------- remote protocol support, common ----------
 
 # remote push initiator/responder protocol:
@@ -221,9 +230,9 @@ sub protocol_receive_file ($$) {
        my ($y,$l) = protocol_expect {
            m/^data-block (.*})$|data-end$/;
            length $1 ? (1,$1) : (0);
-       } \*STDIN;
+       } $fh;
        last unless $y;
-       my $d = protocol_read_bytes \*STDIN, $1;
+       my $d = protocol_read_bytes $fh, $1;
        print PF $d or die $!;
     }
     printdebug "received into $ourfn\n";
@@ -335,8 +344,11 @@ sub runcmd {
     failedcmd @_ if system @_;
 }
 
+sub act_local () { return $dryrun_level <= 1; }
+sub act_scary () { return !$dryrun_level; }
+
 sub printdone {
-    if (!$dryrun) {
+    if (!$dryrun_level) {
        progress "dgit ok: @_";
     } else {
        progress "would be ok: @_ (but dry run only)";
@@ -369,7 +381,15 @@ sub dryrun_report {
 }
 
 sub runcmd_ordryrun {
-    if (!$dryrun) {
+    if (act_scary()) {
+       runcmd @_;
+    } else {
+       dryrun_report @_;
+    }
+}
+
+sub runcmd_ordryrun_local {
+    if (act_local()) {
        runcmd @_;
     } else {
        dryrun_report @_;
@@ -391,6 +411,7 @@ main usages:
 important dgit options:
   -k<keyid>           sign tag and package with <keyid> instead of default
   --dry-run -n        do not change anything, but go through the motions
+  --damp-run -L       like --dry-run but make local changes, without signing
   --new -N            allow introducing a new package
   --debug -D          increase debug level
   -c<name>=<value>    set git config option (used directly by dgit too)
@@ -700,7 +721,7 @@ sub mktree_in_ud_from_only_subdir () {
     die unless @dirs==1;
     $dirs[0] =~ m#^([^/]+)/\.$# or die;
     my $dir = $1;
-    chdir $dir or die "$dir $!";
+    changedir $dir;
     fail "source package contains .git directory" if stat '.git';
     die $! unless $!==&ENOENT;
     runcmd qw(git init -q);
@@ -767,7 +788,7 @@ sub clogp_authline ($) {
 
 sub generate_commit_from_dsc () {
     prep_ud();
-    chdir $ud or die $!;
+    changedir $ud;
     my @files;
     foreach my $f (dsc_files()) {
        die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
@@ -833,7 +854,7 @@ END
            $outputhash = $lastpush_hash;
        }
     }
-    chdir '../../../..' or die $!;
+    changedir '../../../..';
     runcmd @git, qw(update-ref -m),"dgit fetch import $cversion",
             'DGIT_ARCHIVE', $outputhash;
     cmdoutput @git, qw(log -n2), $outputhash;
@@ -865,7 +886,7 @@ sub ensure_we_have_orig () {
        $origurl .= "/$f";
        die "$f ?" unless $f =~ m/^${package}_/;
        die "$f ?" if $f =~ m#/#;
-       runcmd_ordryrun shell_cmd 'cd ..', @dget,'--',$origurl;
+       runcmd_ordryrun_local shell_cmd 'cd ..', @dget,'--',$origurl;
     }
 }
 
@@ -886,7 +907,7 @@ sub is_fast_fwd ($$) {
 }
 
 sub git_fetch_us () {
-    runcmd_ordryrun @git, qw(fetch),access_giturl(),fetchspec();
+    runcmd_ordryrun_local @git, qw(fetch),access_giturl(),fetchspec();
 }
 
 sub fetch_from_archive () {
@@ -993,7 +1014,7 @@ END
     }
     if ($lastpush_hash ne $hash) {
        my @upd_cmd = (@git, qw(update-ref -m), 'dgit fetch', lrref(), $hash);
-       if (!$dryrun) {
+       if (act_local()) {
            cmdoutput @upd_cmd;
        } else {
            dryrun_report @upd_cmd;
@@ -1005,9 +1026,9 @@ END
 sub clone ($) {
     my ($dstdir) = @_;
     canonicalise_suite();
-    badusage "dry run makes no sense with clone" if $dryrun;
+    badusage "dry run makes no sense with clone" unless act_local();
     mkdir $dstdir or die "$dstdir $!";
-    chdir "$dstdir" or die "$dstdir $!";
+    changedir $dstdir;
     runcmd @git, qw(init -q);
     runcmd @git, qw(config), "remote.$remotename.fetch", fetchspec();
     open H, "> .git/HEAD" or die $!;
@@ -1017,7 +1038,7 @@ sub clone ($) {
     if (check_for_git()) {
        progress "fetching existing git history";
        git_fetch_us();
-       runcmd_ordryrun @git, qw(fetch origin);
+       runcmd_ordryrun_local @git, qw(fetch origin);
     } else {
        progress "starting new git history";
     }
@@ -1036,7 +1057,7 @@ sub fetch () {
 
 sub pull () {
     fetch();
-    runcmd_ordryrun @git, qw(merge -m),"Merge from $csuite [dgit]",
+    runcmd_ordryrun_local @git, qw(merge -m),"Merge from $csuite [dgit]",
         lrref();
     printdone "fetched to ".lrref()." and merged into HEAD";
 }
@@ -1057,25 +1078,20 @@ sub check_not_dirty () {
 sub commit_quilty_patch () {
     my $output = cmdoutput @git, qw(status --porcelain);
     my %adds;
-    my $bad=0;
     foreach my $l (split /\n/, $output) {
        next unless $l =~ m/\S/;
        if ($l =~ m{^(?:\?\?| M) (.pc|debian/patches)}) {
            $adds{$1}++;
-       } else {
-           print STDERR "git status: $l\n";
-           $bad++;
        }
     }
-    fail "unexpected output from git status (is tree clean?)" if $bad;
     if (!%adds) {
        progress "nothing quilty to commit, ok.";
        return;
     }
-    runcmd_ordryrun @git, qw(add), sort keys %adds;
+    runcmd_ordryrun_local @git, qw(add), sort keys %adds;
     my $m = "Commit Debian 3.0 (quilt) metadata";
     progress "$m";
-    runcmd_ordryrun @git, qw(commit -m), $m;
+    runcmd_ordryrun_local @git, qw(commit -m), $m;
 }
 
 sub madformat ($) {
@@ -1157,7 +1173,7 @@ END
        push @sign_cmd, qw(-u),$keyid if defined $keyid;
        push @sign_cmd, $tfn->('.tmp');
        runcmd_ordryrun @sign_cmd;
-       if (!$dryrun) {
+       if (act_scary()) {
            $tagobjfn = $tfn->('.signed.tmp');
            runcmd shell_cmd "exec >$tagobjfn", qw(cat --),
                $tfn->('.tmp'), $tfn->('.tmp.asc');
@@ -1204,11 +1220,11 @@ sub dopush () {
        commit_quilty_patch();
     }
     check_not_dirty();
-    chdir $ud or die $!;
+    changedir $ud;
     progress "checking that $dscfn corresponds to HEAD";
     runcmd qw(dpkg-source -x --), "../../../../$dscfn";
     my ($tree,$dir) = mktree_in_ud_from_only_subdir();
-    chdir '../../../..' or die $!;
+    changedir '../../../..';
     my @diffcmd = (@git, qw(diff --exit-code), $tree);
     printcmd \*DEBUG,$debugprefix."+",@diffcmd;
     $!=0; $?=0;
@@ -1256,7 +1272,7 @@ sub dopush () {
 
     my $tag_obj_hash = cmdoutput @git, qw(hash-object -w -t tag), $tagobjfn;
     runcmd_ordryrun @git, qw(verify-tag), $tag_obj_hash;
-    runcmd_ordryrun @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash;
+    runcmd_ordryrun_local @git, qw(update-ref), "refs/tags/$tag", $tag_obj_hash;
     runcmd_ordryrun @git, qw(tag -v --), $tag;
 
     if (!check_for_git()) {
@@ -1266,7 +1282,7 @@ sub dopush () {
     runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD';
 
     if (!$we_are_responder) {
-       if (!$dryrun) {
+       if (act_local()) {
            rename "../$dscfn.tmp","../$dscfn" or die "$dscfn $!";
        } else {
            progress "[new .dsc left in $dscfn.tmp]";
@@ -1274,7 +1290,7 @@ sub dopush () {
     }
 
     if ($we_are_responder) {
-       my $dryrunsuffix = $dryrun ? ".tmp" : "";
+       my $dryrunsuffix = act_local() ? "" : ".tmp";
        responder_receive_files('signed-dsc-changes',
                                "../$dscfn$dryrunsuffix",
                                "$changesfile$dryrunsuffix");
@@ -1401,10 +1417,10 @@ sub cmd_remote_push_responder {
     @ARGV = @ARGV[$nrargs..$#ARGV];
     die unless @rargs;
     my ($dir) = @rargs;
-    chdir $dir or die "$dir: $!";
-    $we_are_responder = 1;
     $debugprefix = ' ';
-    $|=1;
+    changedir $dir;
+    $we_are_responder = 1;
+    autoflush STDOUT 1;
     responder_send_command("dgit-remote-push-ready");
     &cmd_push;
 }
@@ -1414,7 +1430,8 @@ our $i_tmp;
 sub i_cleanup {
     local ($@);
     return unless defined $i_tmp;
-    chdir "/" or die $!;
+    return if defined $initiator_tempdir;
+    changedir "/";
     eval { rmtree $i_tmp; };
 }
 
@@ -1443,9 +1460,15 @@ sub cmd_rpush {
     my @cmd = (@ssh, $host, shellquote @rdgit);
     printcmd \*DEBUG,$debugprefix."+",@cmd;
     eval {
-       $i_tmp = tempdir();
+       if (defined $initiator_tempdir) {
+           rmtree $initiator_tempdir;
+           mkdir $initiator_tempdir, 0700 or die "$initiator_tempdir: $!";
+           $i_tmp = $initiator_tempdir;
+       } else {
+           $i_tmp = tempdir();
+       }
        my $pid = open2(\*RO, \*RI, @cmd);
-       chdir $i_tmp or die "$i_tmp $!";
+       changedir $i_tmp;
        initiator_expect { m/^dgit-remote-push-ready/ };
        for (;;) {
            my ($icmd,$iargs) = initiator_expect {
@@ -1577,7 +1600,7 @@ END
        local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0;
        local $ENV{'VISUAL'} = $ENV{'EDITOR'};
        local $ENV{$fakeeditorenv} = cmdoutput qw(realpath --), $descfn;
-       runcmd_ordryrun @dpkgsource, qw(--commit .), $patchname;
+       runcmd_ordryrun_local @dpkgsource, qw(--commit .), $patchname;
     }
 
     if (!open P, '>>', ".pc/applied-patches") {
@@ -1622,7 +1645,7 @@ sub cmd_build {
     badusage "dgit build implies --clean=dpkg-source"
        if $cleanmode ne 'dpkg-source';
     build_prep();
-    runcmd_ordryrun @dpkgbuildpackage, qw(-us -uc), changesopts(), @ARGV;
+    runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc), changesopts(), @ARGV;
     printdone "build successful\n";
 }
 
@@ -1638,7 +1661,7 @@ sub cmd_git_build {
        push @cmd, "--git-debian-branch=".lbranch();
     }
     push @cmd, changesopts();
-    runcmd_ordryrun @cmd, @ARGV;
+    runcmd_ordryrun_local @cmd, @ARGV;
     printdone "build successful\n";
 }
 
@@ -1647,20 +1670,21 @@ sub build_source {
     $sourcechanges = "${package}_".(stripepoch $version)."_source.changes";
     $dscfn = dscfn($version);
     if ($cleanmode eq 'dpkg-source') {
-       runcmd_ordryrun (@dpkgbuildpackage, qw(-us -uc -S)), changesopts();
+       runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S)),
+           changesopts();
     } else {
        if ($cleanmode eq 'git') {
-           runcmd_ordryrun @git, qw(clean -xdf);
+           runcmd_ordryrun_local @git, qw(clean -xdf);
        } elsif ($cleanmode eq 'none') {
        } else {
            die "$cleanmode ?";
        }
        my $pwd = cmdoutput qw(env - pwd);
        my $leafdir = basename $pwd;
-       chdir ".." or die $!;
-       runcmd_ordryrun @dpkgsource, qw(-b --), $leafdir;
-       chdir $pwd or die $!;
-       runcmd_ordryrun qw(sh -ec),
+       changedir "..";
+       runcmd_ordryrun_local @dpkgsource, qw(-b --), $leafdir;
+       changedir $pwd;
+       runcmd_ordryrun_local qw(sh -ec),
            'exec >$1; shift; exec "$@"','x',
            "../$sourcechanges",
            @dpkggenchanges, qw(-S), changesopts();
@@ -1675,9 +1699,9 @@ sub cmd_build_source {
 
 sub cmd_sbuild {
     build_source();
-    chdir ".." or die $!;
+    changedir "..";
     my $pat = "${package}_".(stripepoch $version)."_*.changes";
-    if (!$dryrun) {
+    if (act_local()) {
        stat $dscfn or fail "$dscfn (in parent directory): $!";
        stat $sourcechanges or fail "$sourcechanges (in parent directory): $!";
        foreach my $cf (glob $pat) {
@@ -1685,10 +1709,10 @@ sub cmd_sbuild {
            unlink $cf or fail "remove $cf: $!";
        }
     }
-    runcmd_ordryrun @sbuild, @ARGV, qw(-d), $isuite, $dscfn;
-    runcmd_ordryrun @mergechanges, glob $pat;
+    runcmd_ordryrun_local @sbuild, @ARGV, qw(-d), $isuite, $dscfn;
+    runcmd_ordryrun_local @mergechanges, glob $pat;
     my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
-    if (!$dryrun) {
+    if (act_local()) {
        stat $multichanges or fail "$multichanges: $!";
     }
     printdone "build successful, results in $multichanges\n" or die $!;
@@ -1724,7 +1748,10 @@ sub parseopts () {
        if (m/^--/) {
            if (m/^--dry-run$/) {
                push @ropts, $_;
-               $dryrun=1;
+               $dryrun_level=2;
+           } elsif (m/^--damp-run$/) {
+               push @ropts, $_;
+               $dryrun_level=1;
            } elsif (m/^--no-sign$/) {
                push @ropts, $_;
                $sign=0;
@@ -1748,6 +1775,11 @@ sub parseopts () {
            } elsif (m/^--existing-package=(.*)/s) {
                push @ropts, $_;
                $existing_package = $1;
+           } elsif (m/^--initiator-tempdir=(.*)/s) {
+               $initiator_tempdir = $1;
+               $initiator_tempdir =~ m#^/# or
+                   badusage "--initiator-tempdir must be used specify an".
+                       " absolute, not relative, directory."
            } elsif (m/^--distro=(.*)/s) {
                push @ropts, $_;
                $idistro = $1;
@@ -1768,13 +1800,17 @@ sub parseopts () {
        } else {
            while (m/^-./s) {
                if (s/^-n/-/) {
-                   push @ropts, $_;
-                   $dryrun=1;
+                   push @ropts, $&;
+                   $dryrun_level=2;
+               } elsif (s/^-L/-/) {
+                   push @ropts, $&;
+                   $dryrun_level=1;
                } elsif (s/^-h/-/) {
                    cmd_help();
                } elsif (s/^-D/-/) {
                    push @ropts, $&;
                    open DEBUG, ">&STDERR" or die $!;
+                   autoflush DEBUG 1;
                    $debug++;
                } elsif (s/^-N/-/) {
                    push @ropts, $&;
@@ -1818,7 +1854,9 @@ if ($ENV{$fakeeditorenv}) {
 delete $ENV{'DGET_UNPACK'};
 
 parseopts();
-print STDERR "DRY RUN ONLY\n" if $dryrun;
+print STDERR "DRY RUN ONLY\n" if $dryrun_level > 1;
+print STDERR "DAMP RUN - WILL MAKE LOCAL (UNSIGNED) CHANGES\n"
+    if $dryrun_level == 1;
 if (!@ARGV) {
     print STDERR $helpmsg or die $!;
     exit 8;