X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=ae2684b95c485efe91124c1dcf3aa774fd4395bf;hp=9936c5f943645d1956254535f0ebfd7da8f27442;hb=08434a9b27bc7f911ab64cac7a66756caa0cb9d6;hpb=bdcfbefe02a6dba3f869e1a93e98e107a80edc7b diff --git a/dgit b/dgit index 9936c5f9..ae2684b9 100755 --- a/dgit +++ b/dgit @@ -44,6 +44,7 @@ our $buildproductsdir = '..'; 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; @@ -52,6 +53,8 @@ our $initiator_tempdir; 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); @@ -118,6 +121,15 @@ sub dscfn ($) { 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 { @@ -457,7 +469,7 @@ our %defcfg = ('dgit.default.distro' => 'debian', '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", @@ -469,14 +481,6 @@ our %defcfg = ('dgit.default.distro' => 'debian', 'dgit-distro.test-dummy.archive-query' => "dummycat:$td/aq", 'dgit-distro.test-dummy.mirror' => "file://$td/mirror/", 'dgit-distro.test-dummy.upload-host' => 'test-dummy', - 'dgit-distro.test-dummy-drs.ssh' => "$td/ssh", - 'dgit-distro.test-dummy-drs.username' => "alice", - 'dgit-distro.test-dummy-drs.git-check' => "true", - 'dgit-distro.test-dummy-drs.git-create' => "true", - 'dgit-distro.test-dummy-drs.git-url' => "$td/git", - 'dgit-distro.test-dummy-drs.archive-query' => "dummycat:$td/aq", - 'dgit-distro.test-dummy-drs.mirror' => "file://$td/mirror/", - 'dgit-distro.test-dummy-drs.upload-host' => 'test-dummy', ); sub cfg { @@ -496,12 +500,19 @@ sub cfg { my $dv = $defcfg{$c}; return $dv if defined $dv; } - badcfg "need value for one of: @_"; + badcfg "need value for one of: @_\n". + "$us: distro or suite appears not to be (properly) supported"; } sub access_basedistro () { - return cfg("dgit-suite.$isuite.distro", - "dgit.default.distro"); + if (defined $idistro) { + return cfg("dgit-distro.basedistro.distro", + "dgit-suite.$isuite.distro", + 'RETURN-UNDEF') // $idistro; + } else { + return cfg("dgit-suite.$isuite.distro", + "dgit.default.distro"); + } } sub access_quirk () { @@ -511,9 +522,10 @@ sub access_quirk () { '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); } @@ -629,6 +641,12 @@ sub git_get_ref ($) { } } +sub must_getcwd () { + my $d = getcwd(); + defined $d or fail "getcwd failed: $!"; + return $d; +} + our %rmad; sub archive_query ($) { @@ -1312,7 +1330,7 @@ type commit tag $tag tagger $authline -$package release $cversion for $clogsuite [dgit] +$package release $cversion for $clogsuite ($csuite) [dgit] END close TO or die $!; @@ -1380,13 +1398,17 @@ sub dopush () { $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; } @@ -1419,6 +1441,7 @@ sub dopush () { 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; @@ -1485,7 +1508,22 @@ sub cmd_clone { 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 () { @@ -1731,10 +1769,13 @@ sub i_file_changes { } 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 = @@ -1917,7 +1958,7 @@ sub build_source { 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; @@ -2045,6 +2086,9 @@ sub parseopts () { } 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 \`$_'"; }