+}
+
+sub cmd_fetch {
+ parseopts();
+ fetchpullargs();
+ fetch();
+}
+
+sub cmd_pull {
+ parseopts();
+ fetchpullargs();
+ pull();
+}
+
+sub cmd_push {
+ parseopts();
+ badusage "-p is not allowed with dgit push" if defined $package;
+ check_not_dirty();
+ my $clogp = parsechangelog();
+ $package = getfield $clogp, 'Source';
+ my $specsuite;
+ if (@ARGV==0) {
+ } elsif (@ARGV==1) {
+ ($specsuite) = (@ARGV);
+ } else {
+ badusage "incorrect arguments to dgit push";
+ }
+ $isuite = getfield $clogp, 'Distribution';
+ if ($new_package) {
+ local ($package) = $existing_package; # this is a hack
+ canonicalise_suite();
+ }
+ if (defined $specsuite && $specsuite ne $isuite) {
+ canonicalise_suite();
+ $csuite eq $specsuite or
+ fail "dgit push: changelog specifies $isuite ($csuite)".
+ " but command line specifies $specsuite";
+ }
+ if (check_for_git()) {
+ git_fetch_us();
+ }
+ if (fetch_from_archive()) {
+ is_fast_fwd(lrref(), 'HEAD') or
+ fail "dgit push: HEAD is not a descendant".
+ " of the archive's version.\n".
+ "$us: To overwrite it, use git-merge -s ours ".lrref().".";
+ } else {
+ $new_package or
+ fail "package appears to be new in this suite;".
+ " if this is intentional, use --new";
+ }
+ dopush();
+}
+
+#---------- remote commands' implementation ----------
+
+sub cmd_remote_push_responder {
+ my ($nrargs) = shift @ARGV;
+ my (@rargs) = @ARGV[0..$nrargs-1];
+ @ARGV = @ARGV[$nrargs..$#ARGV];
+ die unless @rargs;
+ my ($dir) = @rargs;
+ chdir $dir or die "$dir: $!";
+ $we_are_responder = 1;
+ $|=1;
+ responder_send_command("dgit-remote-push-ready");
+ &cmd_push;
+}
+
+our $i_tmp;
+
+sub i_cleanup {
+ local ($@);
+ return unless defined $i_tmp;
+ chdir "/" or die $!;
+ eval { rmtree $i_tmp; };
+}
+
+sub i_method {
+ my ($base,$selector,@args) = @_;
+ $selector =~ s/\-/_/g;
+ { no strict qw(refs); &{"${base}_${selector}"}(@args); }
+}
+
+sub cmd_rpush {
+ my $host = nextarg;
+ my $dir;
+ if ($host =~ m/^((?:[^][]|\[[^][]*\])*)\:/) {
+ $host = $1;
+ $dir = $'; #';
+ } else {
+ $dir = nextarg;
+ }
+ $dir =~ s{^-}{./-};
+ my @rargs = ($dir);
+ my @rdgit;
+ push @rdgit, @dgit;
+ push @rdgit, @ropts;
+ push @rdgit, (scalar @rargs), @rargs;
+ push @rdgit, @ARGV;
+ my @cmd = (@ssh, $host, shellquote @rdgit);
+ my $pid = open2(\*RO, \*RI, @cmd);
+ eval {
+ $i_tmp = tempdir();
+ chdir $i_tmp or die "$i_tmp $!";
+ initiator_expect { m/^dgit-remote-push-ready/ };
+ for (;;) {
+ initiator_expect { m/^(\S+)(?: (.*))?$/ };
+ my ($icmd,$iargs) = ($1, $2);
+ i_method "i_resp_", $icmd, $iargs;
+ }
+ };
+ i_cleanup();
+ die $@;
+}
+
+sub i_resp_progress ($) {
+ my ($rhs) = @_;
+ my $msg = protocol_read_bytes \*RO, $rhs;
+ progress $msg;
+}
+
+sub i_resp_complete {
+ i_cleanup();
+ exit 0;
+}
+
+sub i_resp_file ($) {
+ my ($keyword) = @_;
+ my $localname = i_method "i_localname_", $keyword;
+ my $localpath = "$i_tmp/$localname";
+ stat $localpath and badproto \*RO, "file $keyword ($localpath) twice";
+ protocol_receive_file \*RO, $localpath;
+}
+
+our %i_param;
+
+sub i_param ($) {
+ $_[0] =~ m/^(\S+) (.*)$/;
+ $i_param{$1} = $2;
+}
+
+our %i_wanted;
+
+sub i_resp_want ($) {
+ my ($keyword) = @_;
+ die "$keyword ?" if $i_wanted{$keyword}++;
+ my @localpaths = i_method "i_want_", $keyword;
+ foreach my $localpath (@localpaths) {
+ protocol_send_file \*RI, $localpath;
+ }
+ print RI "end-files\n" or die $!;
+}
+
+our ($i_clogp, $i_version, $i_tag, $i_dscfn);
+
+sub i_localname_parsed_changelog { return "remote-changelog.822"; }
+sub i_localname_changes { return "remote.changes"; }
+sub i_localname_dsc {
+ ($i_clogp, $i_version, $i_tag, $i_dscfn) =
+ push_parse_changelog 'remote-changelog.822';
+ die if $i_dscfn =~ m#/|^\W#;
+ return $i_dscfn;
+}
+
+sub i_want_signed_tag {
+ defined $i_param{'head'} && defined $i_dscfn
+ or badproto \*RO, "sequencing error";
+ my $head = $i_param{'head'};
+ die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
+
+ push_parse_dsc $i_dscfn, 'remote dsc',
+
+ push_mktag $head, $i_clogp, $i_tag,
+ $dsc, $i_dscfn,
+ 'remote.changes', 'remote changes',
+ 'tag.tag';
+
+ return 'tag.tag';
+}
+
+sub i_want_signed_dsc_changes {
+ rename "$i_dscfn.tmp","$i_dscfn" or die "$i_dscfn $!";
+ sign_changes 'remote.changes';
+ return ($i_dscfn, 'remote.changes');
+}
+
+#---------- building etc. ----------
+
+our $version;
+our $sourcechanges;
+our $dscfn;
+
+our $fakeeditorenv = 'DGIT_FAKE_EDITOR_QUILT';
+
+sub build_maybe_quilt_fixup () {
+ if (!open F, "debian/source/format") {
+ die $! unless $!==&ENOENT;
+ return;
+ }
+ $_ = <F>;
+ F->error and die $!;
+ chomp;
+ return unless madformat($_);
+ # sigh
+ my $clogp = parsechangelog();
+ my $version = getfield $clogp, 'Version';
+ my $author = getfield $clogp, 'Maintainer';
+ my $headref = rev_parse('HEAD');
+ my $time = time;
+ my $ncommits = 3;
+ my $patchname = "auto-$version-$headref-$time";
+ my $msg = cmdoutput @git, qw(log), "-n$ncommits";
+ mkpath '.git/dgit';
+ my $descfn = ".git/dgit/quilt-description.tmp";
+ open O, '>', $descfn or die "$descfn: $!";
+ $msg =~ s/\n/\n /g;
+ $msg =~ s/^\s+$/ ./mg;
+ print O <<END or die $!;
+Description: Automatically generated patch ($clogp->{Version})
+ Last (up to) $ncommits git changes, FYI:
+ .
+ $msg
+Author: $author
+
+---
+
+END
+ close O or die $!;
+ {
+ 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;
+ }
+
+ if (!open P, '>>', ".pc/applied-patches") {
+ $!==&ENOENT or die $!;
+ } else {
+ close P;
+ }
+
+ commit_quilty_patch();
+}
+
+sub quilt_fixup_editor () {
+ my $descfn = $ENV{$fakeeditorenv};
+ my $editing = $ARGV[$#ARGV];
+ open I1, '<', $descfn or die "$descfn: $!";
+ open I2, '<', $editing or die "$editing: $!";
+ unlink $editing or die "$editing: $!";
+ open O, '>', $editing or die "$editing: $!";
+ while (<I1>) { print O or die $!; } I1->error and die $!;
+ my $copying = 0;
+ while (<I2>) {
+ $copying ||= m/^\-\-\- /;
+ next unless $copying;
+ print O or die $!;
+ }
+ I2->error and die $!;
+ close O or die $1;
+ exit 0;
+}
+
+sub build_prep () {
+ badusage "-p is not allowed when building" if defined $package;
+ check_not_dirty();
+ my $clogp = parsechangelog();
+ $isuite = getfield $clogp, 'Distribution';
+ $package = getfield $clogp, 'Source';
+ $version = getfield $clogp, 'Version';
+ build_maybe_quilt_fixup();
+}
+
+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;
+ printdone "build successful\n";
+}
+
+sub cmd_git_build {
+ badusage "dgit git-build implies --clean=dpkg-source"
+ if $cleanmode ne 'dpkg-source';
+ build_prep();
+ my @cmd =
+ (qw(git-buildpackage -us -uc --git-no-sign-tags),
+ "--git-builder=@dpkgbuildpackage");
+ unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) {
+ canonicalise_suite();
+ push @cmd, "--git-debian-branch=".lbranch();
+ }
+ push @cmd, changesopts();
+ runcmd_ordryrun @cmd, @ARGV;
+ printdone "build successful\n";
+}
+
+sub build_source {
+ build_prep();
+ $sourcechanges = "${package}_".(stripepoch $version)."_source.changes";
+ $dscfn = dscfn($version);
+ if ($cleanmode eq 'dpkg-source') {
+ runcmd_ordryrun (@dpkgbuildpackage, qw(-us -uc -S)), changesopts();
+ } else {
+ if ($cleanmode eq 'git') {
+ runcmd_ordryrun @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),
+ 'exec >$1; shift; exec "$@"','x',
+ "../$sourcechanges",
+ @dpkggenchanges, qw(-S), changesopts();
+ }
+}
+
+sub cmd_build_source {
+ badusage "build-source takes no additional arguments" if @ARGV;
+ build_source();
+ printdone "source built, results in $dscfn and $sourcechanges";
+}
+
+sub cmd_sbuild {
+ build_source();
+ chdir ".." or die $!;
+ my $pat = "${package}_".(stripepoch $version)."_*.changes";
+ if (!$dryrun) {
+ stat $dscfn or fail "$dscfn (in parent directory): $!";
+ stat $sourcechanges or fail "$sourcechanges (in parent directory): $!";
+ foreach my $cf (glob $pat) {
+ next if $cf eq $sourcechanges;
+ unlink $cf or fail "remove $cf: $!";
+ }
+ }
+ runcmd_ordryrun @sbuild, @ARGV, qw(-d), $isuite, $dscfn;
+ runcmd_ordryrun @mergechanges, glob $pat;
+ my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
+ if (!$dryrun) {
+ stat $multichanges or fail "$multichanges: $!";
+ }
+ printdone "build successful, results in $multichanges\n" or die $!;
+}
+
+sub cmd_quilt_fixup {
+ badusage "incorrect arguments to dgit quilt-fixup" if @ARGV;
+ my $clogp = parsechangelog();
+ $version = getfield $clogp, 'Version';
+ build_maybe_quilt_fixup();
+}
+
+#---------- argument parsing and main program ----------
+
+sub cmd_version {
+ print "dgit version $our_version\n" or die $!;
+ exit 0;