our $existing_package = 'dpkg';
our $cleanmode;
our $changes_since_version;
+our $rmchanges;
our $quilt_mode;
our $quilt_modes_re = 'linear|smash|auto|nofix|nocheck';
our $we_are_responder;
our (@dput) = qw(dput);
our (@debsign) = qw(debsign);
our (@gpg) = qw(gpg);
-our (@sbuild) = qw(sbuild -A);
+our (@sbuild) = qw(sbuild);
our (@ssh) = 'ssh';
our (@dgit) = qw(dgit);
our (@dpkgbuildpackage) = qw(dpkg-buildpackage -i\.git/ -I.git);
return srcfn($vsn,".dsc");
}
+sub changespat ($;$) {
+ my ($vsn, $arch) = @_;
+ return "${package}_".(stripepoch $vsn)."_".($arch//'*').".changes";
+}
+
our $us = 'dgit';
initdebug('');
local ($?);
foreach my $f (@end) {
eval { $f->(); };
- warn "$us: cleanup: $@" if length $@;
+ print STDERR "$us: cleanup: $@" if length $@;
}
};
remove_stray_gits();
mktree_in_ud_here();
- my $format=get_source_format();
+ my ($format, $fopts) = get_source_format();
if (madformat($format)) {
rmtree '.pc';
}
my $f = $fi->{Filename};
die "$f ?" if $f =~ m#/|^\.|\.dsc$|\.tmp$#;
- link "../../../$f", $f
+ link_ltarget "../../../$f", $f
or $!==&ENOENT
or die "$f $!";
- complete_file_from_dsc('.', $fi);
+ complete_file_from_dsc('.', $fi)
+ or next;
if (is_orig_file($f)) {
link $f, "../../../../$f"
my $furl = $dscurl;
$furl =~ s{/[^/]+$}{};
$furl .= "/$f";
- die "$f ?" unless $f =~ m/^${package}_/;
+ die "$f ?" unless $f =~ m/^\Q${package}\E_/;
die "$f ?" if $f =~ m#/#;
runcmd_ordryrun_local @curl,qw(-o),$tf,'--',"$furl";
- next if !act_local();
+ return 0 if !act_local();
$downloaded = 1;
}
" demands hash $fi->{Hash} ".
($downloaded ? "(got wrong file from archive!)"
: "(perhaps you should delete this file?)");
+
+ return 1;
}
sub ensure_we_have_orig () {
foreach my $fi (dsc_files_info()) {
my $f = $fi->{Filename};
next unless is_orig_file($f);
- complete_file_from_dsc('..', $fi);
+ complete_file_from_dsc('..', $fi)
+ or next;
}
}
canonicalise_suite();
badusage "dry run makes no sense with clone" unless act_local();
my $hasgit = check_for_git();
- mkdir $dstdir or die "$dstdir $!";
+ mkdir $dstdir or fail "create \`$dstdir': $!";
changedir $dstdir;
runcmd @git, qw(init -q);
my $giturl = access_giturl(1);
}
sub check_not_dirty () {
+ foreach my $f (qw(local-options local-patch-header)) {
+ if (stat_exists "debian/source/$f") {
+ fail "git tree contains debian/source/$f";
+ }
+ }
+
return if $ignoredirty;
+
my @cmd = (@git, qw(diff --quiet HEAD));
debugcmd "+",@cmd;
$!=0; $?=0; system @cmd;
progress "nothing quilty to commit, ok.";
return;
}
- runcmd_ordryrun_local @git, qw(add), sort keys %adds;
+ my @adds = map { s/[][*?\\]/\\$&/g; $_; } sort keys %adds;
+ runcmd_ordryrun_local @git, qw(add -f), @adds;
commit_admin "Commit Debian 3.0 (quilt) metadata";
}
sub get_source_format () {
+ my %options;
+ if (open F, "debian/source/options") {
+ while (<F>) {
+ next if m/^\s*\#/;
+ next unless m/\S/;
+ s/\s+$//; # ignore missing final newline
+ if (m/\s*\#\s*/) {
+ my ($k, $v) = ($`, $'); #');
+ $v =~ s/^"(.*)"$/$1/;
+ $options{$k} = $v;
+ } else {
+ $options{$_} = 1;
+ }
+ }
+ F->error and die $!;
+ close F;
+ } else {
+ die $! unless $!==&ENOENT;
+ }
+
if (!open F, "debian/source/format") {
die $! unless $!==&ENOENT;
return '';
$_ = <F>;
F->error and die $!;
chomp;
- return $_;
+ return ($_, \%options);
}
sub madformat ($) {
}
my $head = git_rev_parse('HEAD');
if (!$changesfile) {
- my $multi = "$buildproductsdir/".
- "${package}_".(stripepoch $cversion)."_multi.changes";
+ my $multi = "$buildproductsdir/".changespat $cversion,'multi';
if (stat_exists "$multi") {
$changesfile = $multi;
} else {
- my $pat = "${package}_".(stripepoch $cversion)."_*.changes";
+ my $pat = changespat $cversion;
my @cs = glob "$buildproductsdir/$pat";
fail "failed to find unique changes file".
" (looked for $pat in $buildproductsdir, or $multi);".
sign_changes $changesfile;
}
- supplementary_message(<<'END');
+ supplementary_message(<<END);
Push failed, while uploading package(s) to the archive server.
You can retry the upload of exactly these same files with dput of:
$changesfile
return if $!==&ENOENT;
die "chdir $cwd_remove: $!";
}
- rmtree($dstdir) or die "remove $dstdir: $!\n";
+ if (stat $dstdir) {
+ rmtree($dstdir) or die "remove $dstdir: $!\n";
+ } elsif (!grep { $! == $_ }
+ (ENOENT, ENOTDIR, EACCES, EPERM, ELOOP)) {
+ } else {
+ print STDERR "check whether to remove $dstdir: $!\n";
+ }
};
}
local $ENV{'EDITOR'} = cmdoutput qw(realpath --), $0;
local $ENV{'VISUAL'} = $ENV{'EDITOR'};
local $ENV{$fakeeditorenv} = cmdoutput qw(realpath --), $descfn;
- runcmd_ordryrun_local @dpkgsource, qw(--commit .), $patchname;
+ runcmd @dpkgsource, qw(--commit .), $patchname;
}
}
remove_stray_gits();
mktree_in_ud_here();
rmtree '.pc';
- runcmd @git, 'add', '.';
+ runcmd @git, qw(add -Af .);
my $oldtiptree=git_write_tree();
changedir '../work';
my $abbrev = sub {
my $x = $_[0]{Commit};
$x =~ s/(.*?[0-9a-z]{8})[0-9a-z]*$/$1/;
- return $;
+ return $x;
};
my $reportnot = sub {
my ($notp) = @_;
}
sub build_maybe_quilt_fixup () {
- my $format=get_source_format;
+ my ($format,$fopts) = get_source_format;
return unless madformat $format;
# sigh
check_for_vendor_patches();
+ my $clogp = parsechangelog();
+ my $headref = git_rev_parse('HEAD');
+
+ prep_ud();
+ changedir $ud;
+
+ my $upstreamversion=$version;
+ $upstreamversion =~ s/-[^-]*$//;
+
+ if ($fopts->{'single-debian-patch'}) {
+ quilt_fixup_singlepatch($clogp, $headref, $upstreamversion);
+ } else {
+ quilt_fixup_multipatch($clogp, $headref, $upstreamversion);
+ }
+
+ changedir '../../../..';
+ runcmd_ordryrun_local
+ @git, qw(pull --ff-only -q .git/dgit/unpack/work master);
+}
+
+sub quilt_fixup_mkwork ($) {
+ my ($headref) = @_;
+
+ mkdir "work" or die $!;
+ changedir "work";
+ mktree_in_ud_here();
+ runcmd @git, qw(reset --hard), $headref;
+}
+
+sub quilt_fixup_linkorigs ($$) {
+ my ($upstreamversion, $fn) = @_;
+ # calls $fn->($leafname);
+
+ foreach my $f (<../../../../*>) { #/){
+ my $b=$f; $b =~ s{.*/}{};
+ {
+ local ($debuglevel) = $debuglevel-1;
+ printdebug "QF linkorigs $b, $f ?\n";
+ }
+ next unless is_orig_file $b, srcfn $upstreamversion,'';
+ printdebug "QF linkorigs $b, $f Y\n";
+ link_ltarget $f, $b or die "$b $!";
+ $fn->($b);
+ }
+}
+
+sub quilt_fixup_delete_pc () {
+ runcmd @git, qw(rm -rqf .pc);
+ commit_admin "Commit removal of .pc (quilt series tracking data)";
+}
+
+sub quilt_fixup_singlepatch ($$$) {
+ my ($clogp, $headref, $upstreamversion) = @_;
+
+ progress "starting quiltify (single-debian-patch)";
+
+ # dpkg-source --commit generates new patches even if
+ # single-debian-patch is in debian/source/options. In order to
+ # get it to generate debian/patches/debian-changes, it is
+ # necessary to build the source package.
+
+ quilt_fixup_linkorigs($upstreamversion, sub { });
+ quilt_fixup_mkwork($headref);
+
+ rmtree("debian/patches");
+
+ runcmd @dpkgsource, qw(-b .);
+ chdir "..";
+ runcmd @dpkgsource, qw(-x), (srcfn $version, ".dsc");
+ rename srcfn("$upstreamversion", "/debian/patches"),
+ "work/debian/patches";
+
+ chdir "work";
+ commit_quilty_patch();
+
+
+}
+
+sub quilt_fixup_multipatch ($$$) {
+ my ($clogp, $headref, $upstreamversion) = @_;
+
+ progress "starting quiltify (multiple patches, $quilt_mode mode)";
+
# Our objective is:
# - honour any existing .pc in case it has any strangeness
# - determine the git commit corresponding to the tip of
# can work. We do this as follows:
# 1. Collect all relevant .orig from parent directory
# 2. Generate a debian.tar.gz out of
- # debian/{patches,rules,source/format}
+ # debian/{patches,rules,source/format,source/options}
# 3. Generate a fake .dsc containing just these fields:
# Format Source Version Files
# 4. Extract the fake .dsc
# 5. If we had a .pc in-tree, delete it, and git-commit
# 6. Back in the main tree, fast forward to the new HEAD
- my $clogp = parsechangelog();
- my $headref = git_rev_parse('HEAD');
-
- prep_ud();
- changedir $ud;
-
- my $upstreamversion=$version;
- $upstreamversion =~ s/-[^-]*$//;
-
my $fakeversion="$upstreamversion-~~DGITFAKE";
my $fakedsc=new IO::File 'fake.dsc', '>' or die $!;
print $fakedsc " ".$md->hexdigest." $size $b\n" or die $!;
};
- foreach my $f (<../../../../*>) { #/){
- my $b=$f; $b =~ s{.*/}{};
- next unless is_orig_file $b, srcfn $upstreamversion,'';
- link $f, $b or die "$b $!";
- $dscaddfile->($b);
- }
+ quilt_fixup_linkorigs($upstreamversion, $dscaddfile);
my @files=qw(debian/source/format debian/rules);
- if (stat_exists '../../../debian/patches') {
- push @files, 'debian/patches';
+ foreach my $maybe (qw(debian/patches debian/source/options)) {
+ next unless stat_exists "../../../$maybe";
+ push @files, $maybe;
}
my $debtar= srcfn $fakeversion,'.debian.tar.gz';
my $fakexdir= $package.'-'.(stripepoch $upstreamversion);
rename $fakexdir, "fake" or die "$fakexdir $!";
- mkdir "work" or die $!;
- changedir "work";
- mktree_in_ud_here();
- runcmd @git, qw(reset --hard), $headref;
+ quilt_fixup_mkwork($headref);
my $mustdeletepc=0;
if (stat_exists ".pc") {
commit_quilty_patch();
if ($mustdeletepc) {
- runcmd @git, qw(rm -rqf .pc);
- commit_admin "Commit removal of .pc (quilt series tracking data)";
+ quilt_fixup_delete_pc();
}
-
- changedir '../../../..';
- runcmd @git, qw(pull --ff-only -q .git/dgit/unpack/work master);
}
sub quilt_fixup_editor () {
$package = getfield $clogp, 'Source';
$version = getfield $clogp, 'Version';
build_maybe_quilt_fixup();
+ if ($rmchanges) {
+ my $pat = changespat $version;
+ foreach my $f (glob "$buildproductsdir/$pat") {
+ if (act_local()) {
+ unlink $f or fail "remove old changes file $f: $!";
+ } else {
+ progress "would remove $f";
+ }
+ }
+ }
}
sub changesopts_initial () {
push @newcmd, '-nc';
# and some combinations of -S, -b, et al, are errors, rather than
# later simply overriding earlier
- push @newcmd, '-F' unless grep { m/^-[bBASF]$/ } (@$cmd, @$xargs);
+ push @newcmd, '-F' unless grep { m/^-[bBASFgG]$/ } (@$cmd, @$xargs);
push @newcmd, @$cmd;
@$cmd = @newcmd;
}
$suppress_clean = 1;
}
build_prep();
- $sourcechanges = "${package}_".(stripepoch $version)."_source.changes";
+ $sourcechanges = changespat $version,'source';
$dscfn = dscfn($version);
if ($cleanmode eq 'dpkg-source') {
- runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S)),
- changesopts();
+ runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S),
+ changesopts();
} elsif ($cleanmode eq 'dpkg-source-d') {
- runcmd_ordryrun_local (@dpkgbuildpackage, qw(-us -uc -S -d)),
- changesopts();
+ runcmd_ordryrun_local @dpkgbuildpackage, qw(-us -uc -S -d),
+ changesopts();
} else {
my $pwd = must_getcwd();
my $leafdir = basename $pwd;
sub cmd_sbuild {
build_source();
changedir "..";
- my $pat = "${package}_".(stripepoch $version)."_*.changes";
+ my $pat = changespat $version;
if (act_local()) {
stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
stat_exists $sourcechanges
unlink $cf or fail "remove $cf: $!";
}
}
- runcmd_ordryrun_local @sbuild, @ARGV, qw(-d), $isuite, $dscfn;
+ runcmd_ordryrun_local @sbuild, qw(-d), $isuite, @ARGV, $dscfn;
my @changesfiles = glob $pat;
@changesfiles = sort {
($b =~ m/_source\.changes$/ <=> $a =~ m/_source\.changes$/)
or $a cmp $b
} @changesfiles;
fail "wrong number of different changes files (@changesfiles)"
- unless @changesfiles;
+ unless @changesfiles==2;
+ my $binchanges = parsecontrol($changesfiles[1], "binary changes file");
+ foreach my $l (split /\n/, getfield $binchanges, 'Files') {
+ fail "$l found in binaries changes file $binchanges"
+ if $l =~ m/\.dsc$/;
+ }
runcmd_ordryrun_local @mergechanges, @changesfiles;
- my $multichanges = "${package}_".(stripepoch $version)."_multi.changes";
+ my $multichanges = changespat $version,'multi';
if (act_local()) {
stat_exists $multichanges or fail "$multichanges: $!";
+ foreach my $cf (glob $pat) {
+ next if $cf eq $multichanges;
+ rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!";
+ }
}
printdone "build successful, results in $multichanges\n" or die $!;
}
my $clogp = parsechangelog();
$version = getfield $clogp, 'Version';
$package = getfield $clogp, 'Source';
+ check_not_dirty();
+ clean_tree();
build_maybe_quilt_fixup();
}
my ($what) = @_;
@rvalopts = ($_);
if (!defined $val) {
- badusage "$what needs a value" unless length @ARGV;
+ badusage "$what needs a value" unless @ARGV;
$val = shift @ARGV;
push @rvalopts, $val;
}
} elsif (m/^--no-rm-on-error$/s) {
push @ropts, $_;
$rmonerror = 0;
+ } elsif (m/^--(no-)?rm-old-changes$/s) {
+ push @ropts, $_;
+ $rmchanges = !$1;
} elsif (m/^--deliberately-($deliberately_re)$/s) {
push @ropts, $_;
push @deliberatelies, $&;
push @ropts, $&;
push @changesopts, $_;
$_ = '';
- } elsif (m/^-[dCk]$/) {
- badusage
- "option \`$_' requires an argument (and no space before the argument)";
} elsif (s/^-wn$//s) {
push @ropts, $&;
$cleanmode = 'none';
my $cmd = shift @ARGV;
$cmd =~ y/-/_/;
+if (!defined $rmchanges) {
+ local $access_forpush;
+ $rmchanges = access_cfg_bool(0, 'rm-old-changes');
+}
+
if (!defined $quilt_mode) {
local $access_forpush;
$quilt_mode = cfg('dgit.force.quilt-mode', 'RETURN-UNDEF')
~ianmdlvl / dgit.git / blobdiff