our $suite_re = '[-+.0-9a-z]+';
our $cleanmode_re = 'dpkg-source(?:-d)?|git|git-ff|check|none';
+our $orig_f_comp_re = 'orig(?:-[-0-9a-z]+)?';
+our $orig_f_sig_re = '\\.(?:asc|gpg|pgp)';
+our $orig_f_tail_re = "$orig_f_comp_re\\.tar(?:\\.\\w+)?(?:$orig_f_sig_re)?";
our $git_authline_re = '^([^<>]+) \<(\S+)\> (\d+ [-+]\d+)$';
our $splitbraincache = 'dgit-intern/quilt-cache';
our (@dpkgsource) = qw(dpkg-source -i\.git/ -I.git);
our (@dpkggenchanges) = qw(dpkg-genchanges);
our (@mergechanges) = qw(mergechanges -f);
-our (@gbp) = qw(gbp);
+our (@gbp_build) = ('');
+our (@gbp_pq) = ('gbp pq');
our (@changesopts) = ('');
our %opts_opt_map = ('dget' => \@dget, # accept for compatibility
'dpkg-source' => \@dpkgsource,
'dpkg-buildpackage' => \@dpkgbuildpackage,
'dpkg-genchanges' => \@dpkggenchanges,
- 'gbp' => \@gbp,
+ 'gbp-build' => \@gbp_build,
+ 'gbp-pq' => \@gbp_pq,
'ch' => \@changesopts,
'mergechanges' => \@mergechanges);
$quilt_mode =~ m/gbp|dpm|unapplied/;
}
+sub opts_opt_multi_cmd {
+ my @cmd;
+ push @cmd, split /\s+/, shift @_;
+ push @cmd, @_;
+ @cmd;
+}
+
+sub gbp_pq {
+ return opts_opt_multi_cmd @gbp_pq;
+}
+
#---------- remote protocol support, common ----------
# remote push initiator/responder protocol:
return 0 if @$dsc_files_info <= 1;
# One file means no origs, and the filename doesn't have a "what
# part of dsc" component. (Consider versions ending `.orig'.)
- return 0 unless $f =~ m/\.orig(?:-\w+)?\.tar(?:\.\w+)?$/;
+ return 0 unless $f =~ m/\.$orig_f_tail_re$/o;
return 1;
}
sub is_orig_file_of_vsn ($$) {
my ($f, $upstreamvsn) = @_;
my $base = srcfn $upstreamvsn, '';
- return 0 unless $f =~ m/^\Q$base\E\.orig(?:-\w+)?\.tar(?:\.\w+)?$/;
+ return 0 unless $f =~ m/^\Q$base\E\.$orig_f_tail_re$/;
return 1;
}
my ($out, $in);
my @cmd = (@git, qw(hash-object -w -t commit --stdin));
debugcmd "|",@cmd;
+ print Dumper($text) if $debuglevel > 1;
my $child = open2($out, $in, @cmd) or die $!;
my $h;
eval {
sub generate_commits_from_dsc () {
# See big comment in fetch_from_archive, below.
+ # See also README.dsc-import.
prep_ud();
changedir $ud;
}
}
+ # We unpack and record the orig tarballs first, so that we only
+ # need disk space for one private copy of the unpacked source.
+ # But we can't make them into commits until we have the metadata
+ # from the debian/changelog, so we record the tree objects now and
+ # make them into commits later.
+ my @tartrees;
+ my $upstreamv = $dsc->{version};
+ $upstreamv =~ s/-[^-]+$//;
+ my $orig_f_base = srcfn $upstreamv, '';
+
+ foreach my $fi (@dfi) {
+ # We actually import, and record as a commit, every tarball
+ # (unless there is only one file, in which case there seems
+ # little point.
+
+ my $f = $fi->{Filename};
+ printdebug "import considering $f ";
+ (printdebug "only one dfi\n"), next if @dfi == 1;
+ (printdebug "not tar\n"), next unless $f =~ m/\.tar(\.\w+)?$/;
+ (printdebug "signature\n"), next if $f =~ m/$orig_f_sig_re$/o;
+ my $compr_ext = $1;
+
+ my ($orig_f_part) =
+ $f =~ m/^\Q$orig_f_base\E\.([^._]+)?\.tar(?:\.\w+)?$/;
+
+ printdebug "Y ", (join ' ', map { $_//"(none)" }
+ $compr_ext, $orig_f_part
+ ), "\n";
+
+ my $input = new IO::File $f, '<' or die "$f $!";
+ my $compr_pid;
+ my @compr_cmd;
+
+ if (defined $compr_ext) {
+ my $cname =
+ Dpkg::Compression::compression_guess_from_filename $f;
+ fail "Dpkg::Compression cannot handle file $f in source package"
+ if defined $compr_ext && !defined $cname;
+ my $compr_proc =
+ new Dpkg::Compression::Process compression => $cname;
+ my @compr_cmd = $compr_proc->get_uncompress_cmdline();
+ my $compr_fh = new IO::Handle;
+ my $compr_pid = open $compr_fh, "-|" // die $!;
+ if (!$compr_pid) {
+ open STDIN, "<&", $input or die $!;
+ exec @compr_cmd;
+ die "dgit (child): exec $compr_cmd[0]: $!\n";
+ }
+ $input = $compr_fh;
+ }
+
+ rmtree "../unpack-tar";
+ mkdir "../unpack-tar" or die $!;
+ my @tarcmd = qw(tar -x -f -
+ --no-same-owner --no-same-permissions
+ --no-acls --no-xattrs --no-selinux);
+ my $tar_pid = fork // die $!;
+ if (!$tar_pid) {
+ chdir "../unpack-tar" or die $!;
+ open STDIN, "<&", $input or die $!;
+ exec @tarcmd;
+ die "dgit (child): exec $tarcmd[0]: $!";
+ }
+ $!=0; (waitpid $tar_pid, 0) == $tar_pid or die $!;
+ !$? or failedcmd @tarcmd;
+
+ close $input or
+ (@compr_cmd ? failedcmd @compr_cmd
+ : die $!);
+ # finally, we have the results in "tarball", but maybe
+ # with the wrong permissions
+
+ runcmd qw(chmod -R +rwX ../unpack-tar);
+ changedir "../unpack-tar";
+ my ($tree) = mktree_in_ud_from_only_subdir(1);
+ changedir "../../unpack";
+ rmtree "../unpack-tar";
+
+ my $ent = [ $f, $tree ];
+ push @tartrees, {
+ Orig => !!$orig_f_part,
+ Sort => (!$orig_f_part ? 2 :
+ $orig_f_part =~ m/-/g ? 1 :
+ 0),
+ F => $f,
+ Tree => $tree,
+ };
+ }
+
+ @tartrees = sort {
+ # put any without "_" first (spec is not clear whether files
+ # are always in the usual order). Tarballs without "_" are
+ # the main orig or the debian tarball.
+ $a->{Sort} <=> $b->{Sort} or
+ $a->{F} cmp $b->{F}
+ } @tartrees;
+
+ my $any_orig = grep { $_->{Orig} } @tartrees;
+
my $dscfn = "$package.dsc";
+ my $treeimporthow = 'package';
+
open D, ">", $dscfn or die "$dscfn: $!";
print D $dscdata or die "$dscfn: $!";
close D or die "$dscfn: $!";
my @cmd = qw(dpkg-source);
push @cmd, '--no-check' if $dsc_checked;
+ if (madformat $dsc->{format}) {
+ push @cmd, '--skip-patches';
+ $treeimporthow = 'unpatched';
+ }
push @cmd, qw(-x --), $dscfn;
runcmd @cmd;
my ($tree,$dir) = mktree_in_ud_from_only_subdir();
- check_for_vendor_patches() if madformat($dsc->{format});
- runcmd qw(sh -ec), 'dpkg-parsechangelog >../changelog.tmp';
- my $clogp = parsecontrol('../changelog.tmp',"commit's changelog");
+ if (madformat $dsc->{format}) {
+ check_for_vendor_patches();
+ }
+
+ my $dappliedtree;
+ if (madformat $dsc->{format}) {
+ my @pcmd = qw(dpkg-source --before-build .);
+ runcmd shell_cmd 'exec >/dev/null', @pcmd;
+ rmtree '.pc';
+ runcmd @git, qw(add -Af);
+ $dappliedtree = git_write_tree();
+ }
+
+ my @clogcmd = qw(dpkg-parsechangelog --format rfc822 --all);
+ debugcmd "|",@clogcmd;
+ open CLOGS, "-|", @clogcmd or die $!;
+
+ my $clogp;
+ my $r1clogp;
+
+ printdebug "import clog search...\n";
+
+ for (;;) {
+ my $stanzatext = do { local $/=""; <CLOGS>; };
+ printdebug "import clogp ".Dumper($stanzatext) if $debuglevel>1;
+ last if !defined $stanzatext;
+
+ my $desc = "package changelog, entry no.$.";
+ open my $stanzafh, "<", \$stanzatext or die;
+ my $thisstanza = parsecontrolfh $stanzafh, $desc, 1;
+ $clogp //= $thisstanza;
+
+ printdebug "import clog $thisstanza->{version} $desc...\n";
+
+ last if !$any_orig; # we don't need $r1clogp
+
+ # We look for the first (most recent) changelog entry whose
+ # version number is lower than the upstream version of this
+ # package. Then the last (least recent) previous changelog
+ # entry is treated as the one which introduced this upstream
+ # version and used for the synthetic commits for the upstream
+ # tarballs.
+
+ # One might think that a more sophisticated algorithm would be
+ # necessary. But: we do not want to scan the whole changelog
+ # file. Stopping when we see an earlier version, which
+ # necessarily then is an earlier upstream version, is the only
+ # realistic way to do that. Then, either the earliest
+ # changelog entry we have seen so far is indeed the earliest
+ # upload of this upstream version; or there are only changelog
+ # entries relating to later upstream versions (which is not
+ # possible unless the changelog and .dsc disagree about the
+ # version). Then it remains to choose between the physically
+ # last entry in the file, and the one with the lowest version
+ # number. If these are not the same, we guess that the
+ # versions were created in a non-monotic order rather than
+ # that the changelog entries have been misordered.
+
+ printdebug "import clog $thisstanza->{version} vs $upstreamv...\n";
+
+ last if version_compare($thisstanza->{version}, $upstreamv) < 0;
+ $r1clogp = $thisstanza;
+
+ printdebug "import clog $r1clogp->{version} becomes r1\n";
+ }
+ die $! if CLOGS->error;
+ close CLOGS or $?==(SIGPIPE<<8) or failedcmd @clogcmd;
+
+ $clogp or fail "package changelog has no entries!";
+
my $authline = clogp_authline $clogp;
my $changes = getfield $clogp, 'Changes';
+ my $cversion = getfield $clogp, 'Version';
+
+ if (@tartrees) {
+ $r1clogp //= $clogp; # maybe there's only one entry;
+ my $r1authline = clogp_authline $r1clogp;
+ # Strictly, r1authline might now be wrong if it's going to be
+ # unused because !$any_orig. Whatever.
+
+ printdebug "import tartrees authline $authline\n";
+ printdebug "import tartrees r1authline $r1authline\n";
+
+ foreach my $tt (@tartrees) {
+ printdebug "import tartree $tt->{F} $tt->{Tree}\n";
+
+ $tt->{Commit} = make_commit_text($tt->{Orig} ? <<END_O : <<END_T);
+tree $tt->{Tree}
+author $r1authline
+committer $r1authline
+
+Import $tt->{F}
+
+[dgit import orig $tt->{F}]
+END_O
+tree $tt->{Tree}
+author $authline
+committer $authline
+
+Import $tt->{F}
+
+[dgit import tarball $package $cversion $tt->{F}]
+END_T
+ }
+ }
+
+ printdebug "import main commit\n";
+
open C, ">../commit.tmp" or die $!;
print C <<END or die $!;
tree $tree
+END
+ print C <<END or die $! foreach @tartrees;
+parent $_->{Commit}
+END
+ print C <<END or die $!;
author $authline
committer $authline
$changes
-# imported from the archive
+[dgit import $treeimporthow $package $cversion]
END
+
close C or die $!;
my $rawimport_hash = make_commit qw(../commit.tmp);
- my $cversion = getfield $clogp, 'Version';
+
+ if (madformat $dsc->{format}) {
+ printdebug "import apply patches...\n";
+
+ # regularise the state of the working tree so that
+ # the checkout of $rawimport_hash works nicely.
+ my $dappliedcommit = make_commit_text(<<END);
+tree $dappliedtree
+author $authline
+committer $authline
+
+[dgit dummy commit]
+END
+ runcmd @git, qw(checkout -q -b dapplied), $dappliedcommit;
+
+ runcmd @git, qw(checkout -q -b unpa), $rawimport_hash;
+
+ # We need the answers to be reproducible
+ my @authline = clogp_authline($clogp);
+ local $ENV{GIT_COMMITTER_NAME} = $authline[0];
+ local $ENV{GIT_COMMITTER_EMAIL} = $authline[1];
+ local $ENV{GIT_COMMITTER_DATE} = $authline[2];
+ local $ENV{GIT_AUTHOR_NAME} = $authline[0];
+ local $ENV{GIT_AUTHOR_EMAIL} = $authline[1];
+ local $ENV{GIT_AUTHOR_DATE} = $authline[2];
+
+ eval {
+ runcmd shell_cmd 'exec >/dev/null 2>../../gbp-pq-output',
+ gbp_pq, qw(import);
+ };
+ if ($@) {
+ { local $@; eval { runcmd qw(cat ../../gbp-pq-output); }; }
+ die $@;
+ }
+
+ my $gapplied = git_rev_parse('HEAD');
+ my $gappliedtree = cmdoutput @git, qw(rev-parse HEAD:);
+ $gappliedtree eq $dappliedtree or
+ fail <<END;
+gbp-pq import and dpkg-source disagree!
+ gbp-pq import gave commit $gapplied
+ gbp-pq import gave tree $gappliedtree
+ dpkg-source --before-build gave tree $dappliedtree
+END
+ $rawimport_hash = $gapplied;
+ }
+
progress "synthesised git commit from .dsc $cversion";
my $rawimport_mergeinput = {
} else {
$hash = $mergeinputs[0]{Commit};
}
- progress "fetch hash=$hash\n";
+ printdebug "fetch hash=$hash\n";
my $chkff = sub {
my ($lasth, $what) = @_;
}
my @adds = map { s/[][*?\\]/\\$&/g; $_; } sort keys %adds;
runcmd_ordryrun_local @git, qw(add -f), @adds;
- commit_admin "Commit Debian 3.0 (quilt) metadata";
+ commit_admin <<END
+Commit Debian 3.0 (quilt) metadata
+
+[dgit ($our_version) quilt-fixup]
+END
}
sub get_source_format () {
mkpath '.git/dgit';
my $descfn = ".git/dgit/quilt-description.tmp";
open O, '>', $descfn or die "$descfn: $!";
- $msg =~ s/\s+$//g;
- $msg =~ s/\n/\n /g;
- $msg =~ s/^\s+$/ ./mg;
+ $msg =~ s/\n+/\n\n/;
print O <<END or die $!;
-Description: $msg
-Author: $author
-$xinfo
+From: $author
+${xinfo}Subject: $msg
---
END
local $ENV{GIT_COMMITTER_NAME} = $authline[0];
local $ENV{GIT_COMMITTER_EMAIL} = $authline[1];
local $ENV{GIT_COMMITTER_DATE} = $authline[2];
-
+ local $ENV{GIT_AUTHOR_NAME} = $authline[0];
+ local $ENV{GIT_AUTHOR_EMAIL} = $authline[1];
+ local $ENV{GIT_AUTHOR_DATE} = $authline[2];
+
if ($quilt_mode =~ m/gbp|unapplied/ &&
($diffbits->{H2O} & 01)) {
my $msg =
($diffbits->{O2A} & 01)) { # some patches
quiltify_splitbrain_needed();
progress "dgit view: creating patches-applied version using gbp pq";
- runcmd shell_cmd 'exec >/dev/null', @gbp, qw(pq import);
+ runcmd shell_cmd 'exec >/dev/null', gbp_pq, qw(import);
# gbp pq import creates a fresh branch; push back to dgit-view
runcmd @git, qw(update-ref refs/heads/dgit-view HEAD);
runcmd @git, qw(checkout -q dgit-view);
.gitignore file(s). This patch is autogenerated, to provide these
updates to users of the official Debian archive view of the package.
-[dgit version $our_version]
+[dgit ($our_version) update-gitignore]
---
END
close GIPATCH or die "$gipatch: $!";
print SERIES "auto-gitignore\n" or die $!;
close SERIES or die $!;
runcmd @git, qw(add -- debian/patches/series), $gipatch;
- commit_admin "Commit patch to update .gitignore";
+ commit_admin <<END
+Commit patch to update .gitignore
+
+[dgit ($our_version) update-gitignore-quilt-fixup]
+END
}
my $dgitview = git_rev_parse 'refs/heads/dgit-view';
$commitdata =~ m/^author (.*) \d+ [-+0-9]+$/m or die "$cc ?";
my $author = $1;
+ my $commitdate = cmdoutput
+ @git, qw(log -n1 --pretty=format:%aD), $cc;
+
$msg =~ s/^(.*)\n*/$1\n/ or die "$cc $msg ?";
+ my $strip_nls = sub { $msg =~ s/\n+$//; $msg .= "\n"; };
+ $strip_nls->();
+
my $title = $1;
- my $patchname = $title;
- $patchname =~ s/[.:]$//;
- $patchname =~ y/ A-Z/-a-z/;
- $patchname =~ y/-a-z0-9_.+=~//cd;
- $patchname =~ s/^\W/x-$&/;
- $patchname = substr($patchname,0,40);
+ my $patchname;
+ my $patchdir;
+
+ my $gbp_check_suitable = sub {
+ $_ = shift;
+ my ($what) = @_;
+
+ eval {
+ die "contains unexpected slashes\n" if m{//} || m{/$};
+ die "contains leading punctuation\n" if m{^\W} || m{/\W};
+ die "contains bad character(s)\n" if m{[^-a-z0-9_.+=~/]}i;
+ die "too long" if length > 200;
+ };
+ return $_ unless $@;
+ print STDERR "quiltifying commit $cc:".
+ " ignoring/dropping Gbp-Pq $what: $@";
+ return undef;
+ };
+
+ if ($msg =~ s/^ (?: gbp(?:-pq)? : \s* name \s+ |
+ gbp-pq-name: \s* )
+ (\S+) \s* \n //ixm) {
+ $patchname = $gbp_check_suitable->($1, 'Name');
+ }
+ if ($msg =~ s/^ (?: gbp(?:-pq)? : \s* topic \s+ |
+ gbp-pq-topic: \s* )
+ (\S+) \s* \n //ixm) {
+ $patchdir = $gbp_check_suitable->($1, 'Topic');
+ }
+
+ $strip_nls->();
+
+ if (!defined $patchname) {
+ $patchname = $title;
+ $patchname =~ s/[.:]$//;
+ $patchname =~ y/ A-Z/-a-z/;
+ $patchname =~ y/-a-z0-9_.+=~//cd;
+ $patchname =~ s/^\W/x-$&/;
+ $patchname = substr($patchname,0,40);
+ }
+ if (!defined $patchdir) {
+ $patchdir = '';
+ }
+ if (length $patchdir) {
+ $patchname = "$patchdir/$patchname";
+ }
+ if ($patchname =~ m{^(.*)/}) {
+ mkpath "debian/patches/$1";
+ }
+
my $index;
for ($index='';
stat "debian/patches/$patchname$index";
runcmd @git, qw(checkout -q), $target, qw(debian/changelog);
quiltify_dpkg_commit "$patchname$index", $author, $msg,
+ "Date: $commitdate\n".
"X-Dgit-Generated: $clogp->{Version} $cc\n";
runcmd @git, qw(checkout -q), $cc, qw(debian/changelog);
sub quilt_fixup_delete_pc () {
runcmd @git, qw(rm -rqf .pc);
- commit_admin "Commit removal of .pc (quilt series tracking data)";
+ commit_admin <<END
+Commit removal of .pc (quilt series tracking data)
+
+[dgit ($our_version) upgrade quilt-remove-pc]
+END
}
sub quilt_fixup_singlepatch ($$$) {
my $wantsrc = massage_dbp_args \@dbp, \@ARGV;
- my @cmd;
- if (length executable_on_path('git-buildpackage')) {
- @cmd = qw(git-buildpackage);
- } else {
- @cmd = qw(gbp buildpackage);
+ if (!length $gbp_build[0]) {
+ if (length executable_on_path('git-buildpackage')) {
+ $gbp_build[0] = qw(git-buildpackage);
+ } else {
+ $gbp_build[0] = 'gbp buildpackage';
+ }
}
+ my @cmd = opts_opt_multi_cmd @gbp_build;
+
push @cmd, (qw(-us -uc --git-no-sign-tags), "--git-builder=@dbp");
if ($wantsrc > 0) {