+ failedcmd @cmd;
+ }
+}
+
+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) {
+ print "nothing quilty to commit, ok.\n";
+ return;
+ }
+ runcmd_ordryrun @git, qw(add), sort keys %adds;
+ my $m = "Commit Debian 3.0 (quilt) metadata";
+ print "$m\n";
+ runcmd_ordryrun @git, qw(commit -m), $m;
+}
+
+sub madformat ($) {
+ my ($format) = @_;
+ return 0 unless $format eq '3.0 (quilt)';
+ print "Format \`$format', urgh\n";
+ if ($noquilt) {
+ print "Not doing any fixup of \`$format' due to --no-quilt-fixup";
+ return 0;
+ }
+ return 1;
+}
+
+sub push_parse_changelog ($) {
+ my ($clogpfn) = @_;
+
+ my $clogp = Dpkg::Control::Hash->new();
+ $clogp->load($clogpfn);
+
+ responder_send_file('parsed-changelog', $clogpfn);
+
+ $package = getfield $clogp, 'Source';
+ my $cversion = getfield $clogp, 'Version';
+ my $tag = debiantag($cversion);
+ runcmd @git, qw(check-ref-format), $tag;
+
+ my $dscfn = dscfn($cversion);
+
+ return ($clogp, $cversion, $tag, $dscfn);
+}
+
+sub push_parse_dsc ($$) {
+ my ($dscfn,$dscfnwhat, $cversion) = @_;
+ $dsc = parsecontrol($dscfn,$dscfnwhat);
+ my $dversion = getfield $dsc, 'Version';
+ my $dscpackage = getfield $dsc, 'Source';
+ ($dscpackage eq $package && $dversion eq $cversion) or
+ fail "$dsc is for $dscpackage $dversion".
+ " but debian/changelog is for $package $cversion";
+}
+
+sub push_mktag ($$$$$$$$) {
+ my ($head,$clogp,$tag,
+ $dsc,$dscfn,
+ $changesfile,$changesfilewhat,
+ $tfn) = @_;
+
+ $dsc->{$ourdscfield[0]} = $head;
+ $dsc->save("$dscfn.tmp") or die $!;
+
+ my $changes = parsecontrol($changesfile,$changesfilewhat);
+ foreach my $field (qw(Source Distribution Version)) {
+ $changes->{$field} eq $clogp->{$field} or
+ fail "changes field $field \`$changes->{$field}'".
+ " does not match changelog \`$clogp->{$field}'";
+ }
+
+ # We make the git tag by hand because (a) that makes it easier
+ # to control the "tagger" (b) we can do remote signing
+ my $authline = clogp_authline $clogp;
+ open TO, '>', $tfn->('.tmp') or die $!;
+ print TO <<END or die $!;
+object $head
+type commit
+tag $tag
+tagger $authline
+
+$package release $cversion for $csuite [dgit]
+END
+ close TO or die $!;
+
+ my $tagobjfn = $tfn->('.tmp');
+ if ($sign) {
+ if (!defined $keyid) {
+ $keyid = access_cfg('keyid','RETURN-UNDEF');
+ }
+ unlink $tfn->('.tmp.asc') or $!==&ENOENT or die $!;
+ my @sign_cmd = (@gpg, qw(--detach-sign --armor));
+ push @sign_cmd, qw(-u),$keyid if defined $keyid;
+ push @sign_cmd, $tfn->('.tmp');
+ runcmd_ordryrun @sign_cmd;
+ if (!$dryrun) {
+ $tagobjfn = $tfn->('.signed.tmp');
+ runcmd shell_cmd "exec >$tagobjfn", qw(cat --),
+ $tfn->('.tmp'), $tfn->('.tmp.asc');
+ }
+ }
+
+ return ($tagobjfn);
+}
+
+sub dopush () {
+ print DEBUG "actually entering push\n";
+ prep_ud();
+
+ runcmd shell_cmd "exec >.git/dgit/changelog.822.tmp",
+ qw(dpkg-parsechangelog);
+
+ my ($clogp, $cversion, $tag, $dscfn) =
+ push_parse_changelog(".git/dgit/changelog.822.tmp");
+
+ stat "../$dscfn" or
+ fail "looked for .dsc $dscfn, but $!;".
+ " maybe you forgot to build";
+
+ push_parse_dsc("../$dscfn", $dscfn, $cversion);
+
+ my $format = getfield $dsc, 'Format';
+ print DEBUG "format $format\n";
+ if (madformat($format)) {
+ commit_quilty_patch();
+ }
+ check_not_dirty();
+ chdir $ud or die $!;
+ print "checking that $dscfn corresponds to HEAD\n";
+ runcmd qw(dpkg-source -x --), "../../../../$dscfn";
+ my ($tree,$dir) = mktree_in_ud_from_only_subdir();
+ chdir '../../../..' or die $!;
+ printcmd \*DEBUG,"+",@_;
+ my @diffcmd = (@git, qw(diff --exit-code), $tree);
+ $!=0; $?=0;
+ if (system @diffcmd) {
+ if ($! && $?==256) {
+ fail "$dscfn specifies a different tree to your HEAD commit;".
+ " perhaps you forgot to build";
+ } else {
+ failedcmd @diffcmd;
+ }
+ }
+#fetch from alioth
+#do fast forward check and maybe fake merge
+# if (!is_fast_fwd(mainbranch
+# runcmd @git, qw(fetch -p ), "$alioth_git/$package.git",
+# map { lref($_).":".rref($_) }
+# (uploadbranch());
+ my $head = rev_parse('HEAD');
+ if (!$changesfile) {
+ my $multi = "../${package}_".(stripepoch $cversion)."_multi.changes";
+ if (stat "$multi") {
+ $changesfile = $multi;
+ } else {
+ $!==&ENOENT or die "$multi: $!";
+ my $pat = "${package}_".(stripepoch $cversion)."_*.changes";
+ my @cs = glob "../$pat";
+ fail "failed to find unique changes file".
+ " (looked for $pat in .., or $multi);".
+ " perhaps you need to use dgit -C"
+ unless @cs==1;
+ ($changesfile) = @cs;
+ }
+ }
+
+ my ($tagobjfn) =
+ push_mktag($head,$clogp,$tag,
+ $dsc,"../$dscfn",
+ $changesfile,$changesfile,
+ sub { ".git/dgit/tag$_[0]"; });
+
+ 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 @git, qw(tag -v --), $tag;
+
+ if (!check_for_git()) {
+ create_remote_git_repo();
+ }
+ runcmd_ordryrun @git, qw(push),access_giturl(),"HEAD:".rrref();
+ runcmd_ordryrun @git, qw(update-ref -m), 'dgit push', lrref(), 'HEAD';
+ if (!$dryrun) {
+ rename "../$dscfn.tmp","../$dscfn" or die "$dscfn $!";
+ } else {
+ print "[new .dsc left in $dscfn.tmp]\n";
+ }
+
+ if ($sign) {
+ my @debsign_cmd = @debsign;
+ push @debsign_cmd, "-k$keyid" if defined $keyid;
+ push @debsign_cmd, $changesfile;
+ runcmd_ordryrun @debsign_cmd;
+ }
+ runcmd_ordryrun @git, qw(push),access_giturl(),"refs/tags/$tag";
+ my $host = access_cfg('upload-host','RETURN-UNDEF');
+ my @hostarg = defined($host) ? ($host,) : ();
+ runcmd_ordryrun @dput, @hostarg, $changesfile;
+ printdone "pushed and uploaded $cversion";
+}
+
+sub cmd_clone {
+ parseopts();
+ my $dstdir;
+ badusage "-p is not allowed with clone; specify as argument instead"
+ if defined $package;
+ if (@ARGV==1) {
+ ($package) = @ARGV;
+ } elsif (@ARGV==2 && $ARGV[1] =~ m#^\w#) {
+ ($package,$isuite) = @ARGV;
+ } elsif (@ARGV==2 && $ARGV[1] =~ m#^[./]#) {
+ ($package,$dstdir) = @ARGV;
+ } elsif (@ARGV==3) {
+ ($package,$isuite,$dstdir) = @ARGV;
+ } else {
+ badusage "incorrect arguments to dgit clone";
+ }
+ $dstdir ||= "$package";
+ clone($dstdir);
+}
+
+sub branchsuite () {
+ my $branch = cmdoutput_errok @git, qw(symbolic-ref HEAD);
+ if ($branch =~ m#$lbranch_re#o) {
+ return $1;
+ } else {
+ return undef;
+ }
+}
+
+sub fetchpullargs () {
+ if (!defined $package) {
+ my $sourcep = parsecontrol('debian/control','debian/control');
+ $package = getfield $sourcep, 'Source';
+ }
+ if (@ARGV==0) {
+# $isuite = branchsuite(); # this doesn't work because dak hates canons
+ if (!$isuite) {
+ my $clogp = parsechangelog();
+ $isuite = getfield $clogp, 'Distribution';
+ }
+ canonicalise_suite();
+ print "fetching from suite $csuite\n";
+ } elsif (@ARGV==1) {
+ ($isuite) = @ARGV;
+ canonicalise_suite();
+ } else {
+ badusage "incorrect arguments to dgit fetch or dgit pull";
+ }
+}
+
+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";