our $new_package = 0;
our $ignoredirty = 0;
our $noquilt = 0;
+our $rmonerror = 1;
our $existing_package = 'dpkg';
our $cleanmode = 'dpkg-source';
our $changes_since_version;
our %format_ok = map { $_=>1 } ("1.0","3.0 (native)","3.0 (quilt)");
+our $suite_re = '[-+.0-9a-z]+';
+
our (@git) = qw(git);
our (@dget) = qw(dget);
our (@dput) = qw(dput);
our $us = 'dgit';
our $debugprefix = '';
+our @end;
+END {
+ local ($?);
+ foreach my $f (@end) {
+ eval { $f->(); };
+ warn "$us: cleanup: $@" if length $@;
+ }
+};
+
sub printdebug { print DEBUG $debugprefix, @_ or die $!; }
sub fail {
'dgit.default.username' => '',
'dgit.default.archive-query-default-component' => 'main',
'dgit.default.ssh' => 'ssh',
- 'dgit-distro.debian.git-user' => 'dgit',
'dgit-distro.debian.git-host' => 'git.debian.org',
'dgit-distro.debian.git-proto' => 'git+ssh://',
- 'dgit-distro.debian.git-path' => '/dgit-repos/',
- 'dgit-distro.debian.git-check' => 'true',
- 'dgit-distro.debian.git-create' => 'true',
+ 'dgit-distro.debian.git-path' => '/git/dgit-repos/repos',
+ 'dgit-distro.debian.git-check' => 'ssh-cmd',
+ 'dgit-distro.debian.git-create' => 'ssh-cmd',
'dgit-distro.debian.sshpsql-host' => 'coccia.debian.org',
'dgit-distro.debian.sshpsql-dbname' => 'service=projectb',
'dgit-distro.debian.upload-host' => 'ftp-master', # for dput
'dgit-distro.debian.mirror' => 'http://ftp.debian.org/debian/',
- 'dgit-distro.debian.backports-quirk' => '%-backports*',
+ 'dgit-distro.debian.backports-quirk' => '(squeeze)-backports*',
'dgit-distro.debian-backports.mirror' => 'http://backports.debian.org/debian-backports/',
'dgit-distro.test-dummy.ssh' => "$td/ssh",
'dgit-distro.test-dummy.username' => "alice",
'RETURN-UNDEF');
if (defined $backports_quirk) {
my $re = $backports_quirk;
- $re =~ s/[^-0-9a-z_\%*]/\\$&/ig;
+ $re =~ s/[^-0-9a-z_\%*()]/\\$&/ig;
$re =~ s/\*/.*/g;
- $re =~ s/\%/([-0-9a-z_]+)/ or badcfg "backports-quirk needs \%";
+ $re =~ s/\%/([-0-9a-z_]+)/
+ or $re =~ m/[()]/ or badcfg "backports-quirk needs \% or ( )";
if ($isuite =~ m/^$re$/) {
return ('backports',"$basedistro-backports",$1);
}
}
}
+sub must_getcwd () {
+ my $d = getcwd();
+ defined $d or fail "getcwd failed: $!";
+ return $d;
+}
+
our %rmad;
sub archive_query ($) {
tag $tag
tagger $authline
-$package release $cversion for $clogsuite [dgit]
+$package release $cversion for $clogsuite ($csuite) [dgit]
END
close TO or die $!;
$dscpath =~ m#^/# ? $dscpath : "../../../$dscpath";
my ($tree,$dir) = mktree_in_ud_from_only_subdir();
changedir '../../../..';
- my @diffcmd = (@git, qw(diff --exit-code), $tree);
+ my $diffopt = $debug>0 ? '--exit-code' : '--quiet';
+ my @diffcmd = (@git, qw(diff), $diffopt, $tree);
printcmd \*DEBUG,$debugprefix."+",@diffcmd;
$!=0; $?=0;
- if (system @diffcmd) {
- if ($! && $?==256) {
+ my $r = system @diffcmd;
+ if ($r) {
+ if ($r==256) {
fail "$dscfn specifies a different tree to your HEAD commit;".
- " perhaps you forgot to build";
+ " perhaps you forgot to build".
+ ($diffopt eq '--exit-code' ? "" :
+ " (run with -D to see full diff output)");
} else {
failedcmd @diffcmd;
}
responder_send_file('changes',$changesfile);
responder_send_command("param head $head");
+ responder_send_command("param csuite $csuite");
my $tfn = sub { ".git/dgit/tag$_[0]"; };
my $tagobjfn;
badusage "incorrect arguments to dgit clone";
}
$dstdir ||= "$package";
+
+ my $cwd_remove;
+ if ($rmonerror && !$dryrun_level) {
+ $cwd_remove= getcwd();
+ unshift @end, sub {
+ return unless defined $cwd_remove;
+ if (!chdir "$cwd_remove") {
+ return if $!==&ENOENT;
+ die "chdir $cwd_remove: $!";
+ }
+ rmtree($dstdir) or die "remove $dstdir: $!\n";
+ };
+ }
+
clone($dstdir);
+ $cwd_remove = undef;
}
sub branchsuite () {
sub i_want_signed_tag {
printdebug Dumper(\%i_param, $i_dscfn);
defined $i_param{'head'} && defined $i_dscfn && defined $i_clogp
+ && defined $i_param{'csuite'}
or badproto \*RO, "premature desire for signed-tag";
my $head = $i_param{'head'};
die if $head =~ m/[^0-9a-f]/ || $head !~ m/^../;
+ die unless $i_param{'csuite'} =~ m/^$suite_re$/;
+ $csuite = $&;
push_parse_dsc $i_dscfn, 'remote dsc', $i_version;
my $tagobjfn =
runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S)),
changesopts();
} else {
- my $pwd = cmdoutput qw(env - pwd);
+ my $pwd = must_getcwd();
my $leafdir = basename $pwd;
changedir "..";
runcmd_ordryrun_local @dpkgsource, qw(-b --), $leafdir;
} elsif (m/^--no-quilt-fixup$/s) {
push @ropts, $_;
$noquilt = 1;
+ } elsif (m/^--no-rm-on-error$/s) {
+ push @ropts, $_;
+ $rmonerror = 0;
} else {
badusage "unknown long option \`$_'";
}