diff options
Diffstat (limited to 'scripts/Dpkg/Source/Package')
| -rw-r--r-- | scripts/Dpkg/Source/Package/V1.pm | 532 | ||||
| -rw-r--r-- | scripts/Dpkg/Source/Package/V2.pm | 766 | ||||
| -rw-r--r-- | scripts/Dpkg/Source/Package/V3/Bzr.pm | 230 | ||||
| -rw-r--r-- | scripts/Dpkg/Source/Package/V3/Custom.pm | 95 | ||||
| -rw-r--r-- | scripts/Dpkg/Source/Package/V3/Git.pm | 300 | ||||
| -rw-r--r-- | scripts/Dpkg/Source/Package/V3/Native.pm | 141 | ||||
| -rw-r--r-- | scripts/Dpkg/Source/Package/V3/Quilt.pm | 289 |
7 files changed, 2353 insertions, 0 deletions
diff --git a/scripts/Dpkg/Source/Package/V1.pm b/scripts/Dpkg/Source/Package/V1.pm new file mode 100644 index 0000000..170ffe1 --- /dev/null +++ b/scripts/Dpkg/Source/Package/V1.pm @@ -0,0 +1,532 @@ +# Copyright © 2008-2009 Raphaël Hertzog <hertzog@debian.org> +# Copyright © 2008, 2012-2015 Guillem Jover <guillem@debian.org> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <https://www.gnu.org/licenses/>. + +=encoding utf8 + +=head1 NAME + +Dpkg::Source::Package::V1 - class for source format 1.0 + +=head1 DESCRIPTION + +This module provides a class to handle the source package format 1.0. + +B<Note>: This is a private module, its API can change at any time. + +=cut + +package Dpkg::Source::Package::V1 0.01; + +use strict; +use warnings; + +use Errno qw(ENOENT); +use Cwd; +use File::Basename; +use File::Temp qw(tempfile); +use File::Spec; + +use Dpkg (); +use Dpkg::Gettext; +use Dpkg::ErrorHandling; +use Dpkg::Compression; +use Dpkg::Source::Archive; +use Dpkg::Source::Patch; +use Dpkg::Exit qw(push_exit_handler pop_exit_handler); +use Dpkg::Source::Functions qw(erasedir); +use Dpkg::Source::Package::V3::Native; + +use parent qw(Dpkg::Source::Package); + +our $CURRENT_MINOR_VERSION = '0'; + +sub init_options { + my $self = shift; + + # Don't call $self->SUPER::init_options() on purpose, V1.0 has no + # ignore by default + if ($self->{options}{diff_ignore_regex}) { + $self->{options}{diff_ignore_regex} .= '|(?:^|/)debian/source/local-.*$'; + } else { + $self->{options}{diff_ignore_regex} = '(?:^|/)debian/source/local-.*$'; + } + $self->{options}{diff_ignore_regex} .= '|(?:^|/)debian/files(?:\.new)?$'; + push @{$self->{options}{tar_ignore}}, + 'debian/source/local-options', + 'debian/source/local-patch-header', + 'debian/files', + 'debian/files.new'; + $self->{options}{sourcestyle} //= 'X'; + $self->{options}{skip_debianization} //= 0; + $self->{options}{ignore_bad_version} //= 0; + $self->{options}{abort_on_upstream_changes} //= 0; + + # Set default validation checks. + $self->{options}{require_valid_signature} //= 0; + $self->{options}{require_strong_checksums} //= 0; + + # V1.0 only supports gzip compression. + $self->{options}{compression} //= 'gzip'; + $self->{options}{comp_level} //= compression_get_level('gzip'); + $self->{options}{comp_ext} //= compression_get_file_extension('gzip'); +} + +my @module_cmdline = ( + { + name => '-sa', + help => N_('auto select original source'), + when => 'build', + }, { + name => '-sk', + help => N_('use packed original source (unpack and keep)'), + when => 'build', + }, { + name => '-sp', + help => N_('use packed original source (unpack and remove)'), + when => 'build', + }, { + name => '-su', + help => N_('use unpacked original source (pack and keep)'), + when => 'build', + }, { + name => '-sr', + help => N_('use unpacked original source (pack and remove)'), + when => 'build', + }, { + name => '-ss', + help => N_('trust packed and unpacked original sources are same'), + when => 'build', + }, { + name => '-sn', + help => N_('there is no diff, do main tarfile only'), + when => 'build', + }, { + name => '-sA, -sK, -sP, -sU, -sR', + help => N_('like -sa, -sk, -sp, -su, -sr but may overwrite'), + when => 'build', + }, { + name => '--abort-on-upstream-changes', + help => N_('abort if generated diff has upstream files changes'), + when => 'build', + }, { + name => '-sp', + help => N_('leave original source packed in current directory'), + when => 'extract', + }, { + name => '-su', + help => N_('do not copy original source to current directory'), + when => 'extract', + }, { + name => '-sn', + help => N_('unpack original source tree too'), + when => 'extract', + }, { + name => '--skip-debianization', + help => N_('do not apply debian diff to upstream sources'), + when => 'extract', + }, +); + +sub describe_cmdline_options { + return @module_cmdline; +} + +sub parse_cmdline_option { + my ($self, $opt) = @_; + my $o = $self->{options}; + if ($opt =~ m/^-s([akpursnAKPUR])$/) { + warning(g_('-s%s option overrides earlier -s%s option'), $1, + $o->{sourcestyle}) if $o->{sourcestyle} ne 'X'; + $o->{sourcestyle} = $1; + $o->{copy_orig_tarballs} = 0 if $1 eq 'n'; # Extract option -sn + return 1; + } elsif ($opt eq '--skip-debianization') { + $o->{skip_debianization} = 1; + return 1; + } elsif ($opt eq '--ignore-bad-version') { + $o->{ignore_bad_version} = 1; + return 1; + } elsif ($opt eq '--abort-on-upstream-changes') { + $o->{abort_on_upstream_changes} = 1; + return 1; + } + return 0; +} + +sub do_extract { + my ($self, $newdirectory) = @_; + my $sourcestyle = $self->{options}{sourcestyle}; + my $fields = $self->{fields}; + + $sourcestyle =~ y/X/p/; + unless ($sourcestyle =~ m/[pun]/) { + usageerr(g_('source handling style -s%s not allowed with -x'), + $sourcestyle); + } + + my $basename = $self->get_basename(); + my $basenamerev = $self->get_basename(1); + + # V1.0 only supports gzip compression + my ($tarfile, $difffile); + my $tarsign; + foreach my $file ($self->get_files()) { + if ($file =~ /^(?:\Q$basename\E\.orig|\Q$basenamerev\E)\.tar\.gz$/) { + error(g_('multiple tarfiles in v1.0 source package')) if $tarfile; + $tarfile = $file; + } elsif ($file =~ /^\Q$basename\E\.orig\.tar\.gz\.asc$/) { + $tarsign = $file; + } elsif ($file =~ /^\Q$basenamerev\E\.diff\.gz$/) { + $difffile = $file; + } else { + error(g_('unrecognized file for a %s source package: %s'), + 'v1.0', $file); + } + } + + error(g_('no tarfile in Files field')) unless $tarfile; + my $native = $difffile ? 0 : 1; + if ($native and ($tarfile =~ /\.orig\.tar\.gz$/)) { + warning(g_('native package with .orig.tar')); + $native = 0; # V3::Native doesn't handle orig.tar + } + + if ($native) { + Dpkg::Source::Package::V3::Native::do_extract($self, $newdirectory); + } else { + my $expectprefix = $newdirectory; + $expectprefix .= '.orig'; + + if ($self->{options}{no_overwrite_dir} and -e $newdirectory) { + error(g_('unpack target exists: %s'), $newdirectory); + } else { + erasedir($newdirectory); + } + if (-e $expectprefix) { + rename($expectprefix, "$newdirectory.tmp-keep") + or syserr(g_("unable to rename '%s' to '%s'"), $expectprefix, + "$newdirectory.tmp-keep"); + } + + info(g_('unpacking %s'), $tarfile); + my $tar = Dpkg::Source::Archive->new( + filename => File::Spec->catfile($self->{basedir}, $tarfile), + ); + $tar->extract($expectprefix); + + if ($sourcestyle =~ /u/) { + # -su: keep .orig directory unpacked + if (-e "$newdirectory.tmp-keep") { + error(g_('unable to keep orig directory (already exists)')); + } + system('cp', '-ar', '--', $expectprefix, "$newdirectory.tmp-keep"); + subprocerr("cp $expectprefix to $newdirectory.tmp-keep") if $?; + } + + rename($expectprefix, $newdirectory) + or syserr(g_('failed to rename newly-extracted %s to %s'), + $expectprefix, $newdirectory); + + # rename the copied .orig directory + if (-e "$newdirectory.tmp-keep") { + rename("$newdirectory.tmp-keep", $expectprefix) + or syserr(g_('failed to rename saved %s to %s'), + "$newdirectory.tmp-keep", $expectprefix); + } + } + + if ($difffile and not $self->{options}{skip_debianization}) { + my $patch = File::Spec->catfile($self->{basedir}, $difffile); + info(g_('applying %s'), $difffile); + my $patch_obj = Dpkg::Source::Patch->new(filename => $patch); + my $analysis = $patch_obj->apply($newdirectory, force_timestamp => 1); + my @files = grep { ! m{^\Q$newdirectory\E/debian/} } + sort keys %{$analysis->{filepatched}}; + info(g_('upstream files that have been modified: %s'), + "\n " . join("\n ", @files)) if scalar @files; + } +} + +sub can_build { + my ($self, $dir) = @_; + + # As long as we can use gzip, we can do it as we have + # native packages as fallback + return (0, g_('only supports gzip compression')) + unless $self->{options}{compression} eq 'gzip'; + return 1; +} + +sub do_build { + my ($self, $dir) = @_; + my $sourcestyle = $self->{options}{sourcestyle}; + my @argv = @{$self->{options}{ARGV}}; + my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}}; + my $diff_ignore_regex = $self->{options}{diff_ignore_regex}; + + if (scalar(@argv) > 1) { + usageerr(g_('-b takes at most a directory and an orig source ' . + 'argument (with v1.0 source package)')); + } + + $sourcestyle =~ y/X/a/; + unless ($sourcestyle =~ m/[akpursnAKPUR]/) { + usageerr(g_('source handling style -s%s not allowed with -b'), + $sourcestyle); + } + + my $sourcepackage = $self->{fields}{'Source'}; + my $basenamerev = $self->get_basename(1); + my $basename = $self->get_basename(); + my $basedirname = $basename; + $basedirname =~ s/_/-/; + + # Try to find a .orig tarball for the package + my $origdir = "$dir.orig"; + my $origtargz = $self->get_basename() . '.orig.tar.gz'; + if (-e $origtargz) { + unless (-f $origtargz) { + error(g_("packed orig '%s' exists but is not a plain file"), $origtargz); + } + } else { + $origtargz = undef; + } + + if (@argv) { + # We have a second-argument <orig-dir> or <orig-targz>, check what it + # is to decide the mode to use + my $origarg = shift(@argv); + if (length($origarg)) { + stat($origarg) + or syserr(g_('cannot stat orig argument %s'), $origarg); + if (-d _) { + $origdir = File::Spec->catdir($origarg); + + $sourcestyle =~ y/aA/rR/; + unless ($sourcestyle =~ m/[ursURS]/) { + error(g_('orig argument is unpacked but source handling ' . + 'style -s%s calls for packed (.orig.tar.<ext>)'), + $sourcestyle); + } + } elsif (-f _) { + $origtargz = $origarg; + $sourcestyle =~ y/aA/pP/; + unless ($sourcestyle =~ m/[kpsKPS]/) { + error(g_('orig argument is packed but source handling ' . + 'style -s%s calls for unpacked (.orig/)'), + $sourcestyle); + } + } else { + error(g_('orig argument %s is not a plain file or directory'), + $origarg); + } + } else { + $sourcestyle =~ y/aA/nn/; + unless ($sourcestyle =~ m/n/) { + error(g_('orig argument is empty (means no orig, no diff) ' . + 'but source handling style -s%s wants something'), + $sourcestyle); + } + } + } elsif ($sourcestyle =~ m/[aA]/) { + # We have no explicit <orig-dir> or <orig-targz>, try to use + # a .orig tarball first, then a .orig directory and fall back to + # creating a native .tar.gz + if ($origtargz) { + $sourcestyle =~ y/aA/pP/; # .orig.tar.<ext> + } else { + if (stat($origdir)) { + unless (-d _) { + error(g_("unpacked orig '%s' exists but is not a directory"), + $origdir); + } + $sourcestyle =~ y/aA/rR/; # .orig directory + } elsif ($! != ENOENT) { + syserr(g_("unable to stat putative unpacked orig '%s'"), $origdir); + } else { + $sourcestyle =~ y/aA/nn/; # Native tar.gz + } + } + } + + my $v = Dpkg::Version->new($self->{fields}->{'Version'}); + if ($sourcestyle =~ m/[kpursKPUR]/) { + error(g_('non-native package version does not contain a revision')) + if $v->is_native(); + } else { + # TODO: This will become fatal in the near future. + warning(g_('native package version may not have a revision')) + unless $v->is_native(); + } + + my ($dirname, $dirbase) = fileparse($dir); + if ($dirname ne $basedirname) { + warning(g_("source directory '%s' is not <sourcepackage>" . + "-<upstreamversion> '%s'"), $dir, $basedirname); + } + + my ($tarname, $tardirname, $tardirbase); + my $tarsign; + if ($sourcestyle ne 'n') { + my ($origdirname, $origdirbase) = fileparse($origdir); + + if ($origdirname ne "$basedirname.orig") { + warning(g_('.orig directory name %s is not <package>' . + '-<upstreamversion> (wanted %s)'), + $origdirname, "$basedirname.orig"); + } + $tardirbase = $origdirbase; + $tardirname = $origdirname; + + $tarname = $origtargz || "$basename.orig.tar.gz"; + $tarsign = "$tarname.asc"; + unless ($tarname =~ /\Q$basename\E\.orig\.tar\.gz/) { + warning(g_('.orig.tar name %s is not <package>_<upstreamversion>' . + '.orig.tar (wanted %s)'), + $tarname, "$basename.orig.tar.gz"); + } + } + + if ($sourcestyle eq 'n') { + $self->{options}{ARGV} = []; # ensure we have no error + Dpkg::Source::Package::V3::Native::do_build($self, $dir); + } elsif ($sourcestyle =~ m/[urUR]/) { + if (stat($tarname)) { + unless ($sourcestyle =~ m/[UR]/) { + error(g_("tarfile '%s' already exists, not overwriting, " . + 'giving up; use -sU or -sR to override'), $tarname); + } + } elsif ($! != ENOENT) { + syserr(g_("unable to check for existence of '%s'"), $tarname); + } + + info(g_('building %s in %s'), + $sourcepackage, $tarname); + + my ($ntfh, $newtar) = tempfile("$tarname.new.XXXXXX", + DIR => getcwd(), UNLINK => 0); + my $tar = Dpkg::Source::Archive->new(filename => $newtar, + compression => compression_guess_from_filename($tarname), + compression_level => $self->{options}{comp_level}); + $tar->create(options => \@tar_ignore, chdir => $tardirbase); + $tar->add_directory($tardirname); + $tar->finish(); + rename($newtar, $tarname) + or syserr(g_("unable to rename '%s' (newly created) to '%s'"), + $newtar, $tarname); + chmod(0666 &~ umask(), $tarname) + or syserr(g_("unable to change permission of '%s'"), $tarname); + } else { + info(g_('building %s using existing %s'), + $sourcepackage, $tarname); + } + + if ($tarname) { + $self->add_file($tarname); + if (-e "$tarname.sig" and not -e "$tarname.asc") { + $self->armor_original_tarball_signature("$tarname.sig", "$tarname.asc"); + } + } + if ($tarsign and -e $tarsign) { + $self->check_original_tarball_signature($dir, $tarsign); + + info(g_('building %s using existing %s'), $sourcepackage, $tarsign); + $self->add_file($tarsign); + } else { + my $key = $self->get_upstream_signing_key($dir); + if (-e $key) { + warning(g_('upstream signing key but no upstream tarball signature')); + } + } + + if ($sourcestyle =~ m/[kpKP]/) { + if (stat($origdir)) { + unless ($sourcestyle =~ m/[KP]/) { + error(g_("orig directory '%s' already exists, not overwriting, ". + 'giving up; use -sA, -sK or -sP to override'), + $origdir); + } + erasedir($origdir); + } elsif ($! != ENOENT) { + syserr(g_("unable to check for existence of orig directory '%s'"), + $origdir); + } + + my $tar = Dpkg::Source::Archive->new(filename => $origtargz); + $tar->extract($origdir); + } + + my $ur; # Unrepresentable changes + if ($sourcestyle =~ m/[kpursKPUR]/) { + my $diffname = "$basenamerev.diff.gz"; + info(g_('building %s in %s'), + $sourcepackage, $diffname); + my ($ndfh, $newdiffgz) = tempfile("$diffname.new.XXXXXX", + DIR => getcwd(), UNLINK => 0); + push_exit_handler(sub { unlink($newdiffgz) }); + my $diff = Dpkg::Source::Patch->new(filename => $newdiffgz, + compression => 'gzip', + compression_level => $self->{options}{comp_level}); + $diff->create(); + $diff->add_diff_directory($origdir, $dir, + basedirname => $basedirname, + diff_ignore_regex => $diff_ignore_regex, + options => []); # Force empty set of options to drop the + # default -p option + $diff->finish() || $ur++; + pop_exit_handler(); + + my $analysis = $diff->analyze($origdir); + my @files = grep { ! m{^debian/} } + map { s{^[^/]+/+}{}r } + sort keys %{$analysis->{filepatched}}; + if (scalar @files) { + warning(g_('the diff modifies the following upstream files: %s'), + "\n " . join("\n ", @files)); + info(g_("use the '3.0 (quilt)' format to have separate and " . + 'documented changes to upstream files, see dpkg-source(1)')); + error(g_('aborting due to --abort-on-upstream-changes')) + if $self->{options}{abort_on_upstream_changes}; + } + + rename($newdiffgz, $diffname) + or syserr(g_("unable to rename '%s' (newly created) to '%s'"), + $newdiffgz, $diffname); + chmod(0666 &~ umask(), $diffname) + or syserr(g_("unable to change permission of '%s'"), $diffname); + + $self->add_file($diffname); + } + + if ($sourcestyle =~ m/[prPR]/) { + erasedir($origdir); + } + + if ($ur) { + errormsg(g_('unrepresentable changes to source')); + exit(1); + } +} + +=head1 CHANGES + +=head2 Version 0.xx + +This is a private module. + +=cut + +1; diff --git a/scripts/Dpkg/Source/Package/V2.pm b/scripts/Dpkg/Source/Package/V2.pm new file mode 100644 index 0000000..1f09461 --- /dev/null +++ b/scripts/Dpkg/Source/Package/V2.pm @@ -0,0 +1,766 @@ +# Copyright © 2008-2011 Raphaël Hertzog <hertzog@debian.org> +# Copyright © 2008-2015 Guillem Jover <guillem@debian.org> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <https://www.gnu.org/licenses/>. + +=encoding utf8 + +=head1 NAME + +Dpkg::Source::Package::V2 - class for source format 2.0 + +=head1 DESCRIPTION + +This module provides a class to handle the source package format 2.0. + +B<Note>: This is a private module, its API can change at any time. + +=cut + +package Dpkg::Source::Package::V2 0.01; + +use strict; +use warnings; + +use List::Util qw(first); +use Cwd; +use File::Basename; +use File::Temp qw(tempfile tempdir); +use File::Path qw(make_path); +use File::Spec; +use File::Find; +use File::Copy; + +use Dpkg::Gettext; +use Dpkg::ErrorHandling; +use Dpkg::File; +use Dpkg::Path qw(find_command); +use Dpkg::Compression; +use Dpkg::Source::Archive; +use Dpkg::Source::Patch; +use Dpkg::Source::BinaryFiles; +use Dpkg::Exit qw(push_exit_handler pop_exit_handler); +use Dpkg::Source::Functions qw(erasedir chmod_if_needed fs_time); +use Dpkg::Vendor qw(run_vendor_hook); +use Dpkg::Control; +use Dpkg::Changelog::Parse; + +use parent qw(Dpkg::Source::Package); + +our $CURRENT_MINOR_VERSION = '0'; + +sub init_options { + my $self = shift; + $self->SUPER::init_options(); + $self->{options}{include_removal} //= 0; + $self->{options}{include_timestamp} //= 0; + $self->{options}{include_binaries} //= 0; + $self->{options}{preparation} //= 1; + $self->{options}{skip_patches} //= 0; + $self->{options}{unapply_patches} //= 'auto'; + $self->{options}{skip_debianization} //= 0; + $self->{options}{create_empty_orig} //= 0; + $self->{options}{auto_commit} //= 0; + $self->{options}{ignore_bad_version} //= 0; +} + +my @module_cmdline = ( + { + name => '--include-removal', + help => N_('include removed files in the patch'), + when => 'build', + }, { + name => '--include-timestamp', + help => N_('include timestamp in the patch'), + when => 'build', + }, { + name => '--include-binaries', + help => N_('include binary files in the tarball'), + when => 'build', + }, { + name => '--no-preparation', + help => N_('do not prepare build tree by applying patches'), + when => 'build', + }, { + name => '--no-unapply-patches', + help => N_('do not unapply patches if previously applied'), + when => 'build', + }, { + name => '--unapply-patches', + help => N_('unapply patches if previously applied (default)'), + when => 'build', + }, { + name => '--create-empty-orig', + help => N_('create an empty original tarball if missing'), + when => 'build', + }, { + name => '--abort-on-upstream-changes', + help => N_('abort if generated diff has upstream files changes'), + when => 'build', + }, { + name => '--auto-commit', + help => N_('record generated patches, instead of aborting'), + when => 'build', + }, { + name => '--skip-debianization', + help => N_('do not extract debian tarball into upstream sources'), + when => 'extract', + }, { + name => '--skip-patches', + help => N_('do not apply patches at the end of the extraction'), + when => 'extract', + } +); + +sub describe_cmdline_options { + return @module_cmdline; +} + +sub parse_cmdline_option { + my ($self, $opt) = @_; + if ($opt eq '--include-removal') { + $self->{options}{include_removal} = 1; + return 1; + } elsif ($opt eq '--include-timestamp') { + $self->{options}{include_timestamp} = 1; + return 1; + } elsif ($opt eq '--include-binaries') { + $self->{options}{include_binaries} = 1; + return 1; + } elsif ($opt eq '--no-preparation') { + $self->{options}{preparation} = 0; + return 1; + } elsif ($opt eq '--skip-patches') { + $self->{options}{skip_patches} = 1; + return 1; + } elsif ($opt eq '--unapply-patches') { + $self->{options}{unapply_patches} = 'yes'; + return 1; + } elsif ($opt eq '--no-unapply-patches') { + $self->{options}{unapply_patches} = 'no'; + return 1; + } elsif ($opt eq '--skip-debianization') { + $self->{options}{skip_debianization} = 1; + return 1; + } elsif ($opt eq '--create-empty-orig') { + $self->{options}{create_empty_orig} = 1; + return 1; + } elsif ($opt eq '--abort-on-upstream-changes') { + $self->{options}{auto_commit} = 0; + return 1; + } elsif ($opt eq '--auto-commit') { + $self->{options}{auto_commit} = 1; + return 1; + } elsif ($opt eq '--ignore-bad-version') { + $self->{options}{ignore_bad_version} = 1; + return 1; + } + return 0; +} + +sub do_extract { + my ($self, $newdirectory) = @_; + my $fields = $self->{fields}; + + my $basename = $self->get_basename(); + my $basenamerev = $self->get_basename(1); + + my ($tarfile, $debianfile, %addonfile, %seen); + my ($tarsign, %addonsign); + my $re_ext = compression_get_file_extension_regex(); + foreach my $file ($self->get_files()) { + my $uncompressed = $file; + $uncompressed =~ s/\.$re_ext$/.*/; + $uncompressed =~ s/\.$re_ext\.asc$/.*.asc/; + error(g_('duplicate files in %s source package: %s'), 'v2.0', + $uncompressed) if $seen{$uncompressed}; + $seen{$uncompressed} = 1; + if ($file =~ /^\Q$basename\E\.orig\.tar\.$re_ext$/) { + $tarfile = $file; + } elsif ($file =~ /^\Q$basename\E\.orig\.tar\.$re_ext\.asc$/) { + $tarsign = $file; + } elsif ($file =~ /^\Q$basename\E\.orig-([[:alnum:]-]+)\.tar\.$re_ext$/) { + $addonfile{$1} = $file; + } elsif ($file =~ /^\Q$basename\E\.orig-([[:alnum:]-]+)\.tar\.$re_ext\.asc$/) { + $addonsign{$1} = $file; + } elsif ($file =~ /^\Q$basenamerev\E\.debian\.tar\.$re_ext$/) { + $debianfile = $file; + } else { + error(g_('unrecognized file for a %s source package: %s'), + 'v2.0', $file); + } + } + + unless ($tarfile and $debianfile) { + error(g_('missing orig.tar or debian.tar file in v2.0 source package')); + } + if ($tarsign and $tarfile ne substr $tarsign, 0, -4) { + error(g_('mismatched orig.tar %s for signature %s in source package'), + $tarfile, $tarsign); + } + foreach my $name (keys %addonsign) { + error(g_('missing addon orig.tar for signature %s in source package'), + $addonsign{$name}) + if not exists $addonfile{$name}; + error(g_('mismatched addon orig.tar %s for signature %s in source package'), + $addonfile{$name}, $addonsign{$name}) + if $addonfile{$name} ne substr $addonsign{$name}, 0, -4; + } + + if ($self->{options}{no_overwrite_dir} and -e $newdirectory) { + error(g_('unpack target exists: %s'), $newdirectory); + } else { + erasedir($newdirectory); + } + + # Extract main tarball + info(g_('unpacking %s'), $tarfile); + my $tar = Dpkg::Source::Archive->new( + filename => File::Spec->catfile($self->{basedir}, $tarfile), + ); + $tar->extract($newdirectory, + options => [ '--anchored', '--no-wildcards-match-slash', + '--exclude', '*/.pc', '--exclude', '.pc' ]); + # The .pc exclusion is only needed for 3.0 (quilt) and to avoid + # having an upstream tarball provide a directory with symlinks + # that would be blindly followed when applying the patches + + # Extract additional orig tarballs + foreach my $subdir (sort keys %addonfile) { + my $file = $addonfile{$subdir}; + info(g_('unpacking %s'), $file); + + # If the pathname is an empty directory, just silently remove it, as + # it might be part of a git repository, as a submodule for example. + rmdir "$newdirectory/$subdir"; + if (-e "$newdirectory/$subdir") { + warning(g_("required removal of '%s' installed by original tarball"), + $subdir); + erasedir("$newdirectory/$subdir"); + } + $tar = Dpkg::Source::Archive->new( + filename => File::Spec->catfile($self->{basedir}, $file), + ); + $tar->extract("$newdirectory/$subdir"); + } + + # Stop here if debianization is not wanted + return if $self->{options}{skip_debianization}; + + # Extract debian tarball after removing the debian directory + info(g_('unpacking %s'), $debianfile); + erasedir("$newdirectory/debian"); + $tar = Dpkg::Source::Archive->new( + filename => File::Spec->catfile($self->{basedir}, $debianfile), + ); + $tar->extract($newdirectory, in_place => 1); + + # Apply patches (in a separate method as it might be overridden) + $self->apply_patches($newdirectory, usage => 'unpack') + unless $self->{options}{skip_patches}; +} + +sub get_autopatch_name { + return 'zz_debian-diff-auto'; +} + +sub _get_patches { + my ($self, $dir, %opts) = @_; + $opts{skip_auto} //= 0; + my @patches; + my $pd = "$dir/debian/patches"; + my $auto_patch = $self->get_autopatch_name(); + if (-d $pd) { + opendir(my $dir_dh, $pd) or syserr(g_('cannot opendir %s'), $pd); + foreach my $patch (sort readdir($dir_dh)) { + # patches match same rules as run-parts + next unless $patch =~ /^[\w-]+$/ and -f "$pd/$patch"; + next if $opts{skip_auto} and $patch eq $auto_patch; + push @patches, $patch; + } + closedir($dir_dh); + } + return @patches; +} + +sub apply_patches { + my ($self, $dir, %opts) = @_; + $opts{skip_auto} //= 0; + my @patches = $self->_get_patches($dir, %opts); + return unless scalar(@patches); + my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied'); + open(my $applied_fh, '>', $applied) + or syserr(g_('cannot write %s'), $applied); + print { $applied_fh } "# During $opts{usage}\n"; + my $timestamp = fs_time($applied); + foreach my $patch ($self->_get_patches($dir, %opts)) { + my $path = File::Spec->catfile($dir, 'debian', 'patches', $patch); + info(g_('applying %s'), $patch) unless $opts{skip_auto}; + my $patch_obj = Dpkg::Source::Patch->new(filename => $path); + $patch_obj->apply($dir, force_timestamp => 1, + timestamp => $timestamp, + add_options => [ '-E' ]); + print { $applied_fh } "$patch\n"; + } + close($applied_fh); +} + +sub unapply_patches { + my ($self, $dir, %opts) = @_; + my @patches = reverse($self->_get_patches($dir, %opts)); + return unless scalar(@patches); + my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied'); + my $timestamp = fs_time($applied); + foreach my $patch (@patches) { + my $path = File::Spec->catfile($dir, 'debian', 'patches', $patch); + info(g_('unapplying %s'), $patch) unless $opts{quiet}; + my $patch_obj = Dpkg::Source::Patch->new(filename => $path); + $patch_obj->apply($dir, force_timestamp => 1, verbose => 0, + timestamp => $timestamp, + add_options => [ '-E', '-R' ]); + } + unlink($applied); +} + +sub _upstream_tarball_template { + my $self = shift; + my $ext = '{' . join(',', + sort map { + compression_get_file_extension($_) + } compression_get_list()) . '}'; + return File::Spec->catfile('..', $self->get_basename() . ".orig.tar.$ext"); +} + +sub can_build { + my ($self, $dir) = @_; + return 1 if $self->find_original_tarballs(include_supplementary => 0); + return 1 if $self->{options}{create_empty_orig} and + $self->find_original_tarballs(include_main => 0); + return (0, sprintf(g_('no upstream tarball found at %s'), + $self->_upstream_tarball_template())); +} + +sub before_build { + my ($self, $dir) = @_; + $self->check_patches_applied($dir) if $self->{options}{preparation}; +} + +sub after_build { + my ($self, $dir) = @_; + my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied'); + my $reason = ''; + if (-e $applied) { + $reason = file_slurp($applied); + } + my $opt_unapply = $self->{options}{unapply_patches}; + if (($opt_unapply eq 'auto' and $reason =~ /^# During preparation/) or + $opt_unapply eq 'yes') { + $self->unapply_patches($dir); + } +} + +sub prepare_build { + my ($self, $dir) = @_; + $self->{diff_options} = { + diff_ignore_regex => $self->{options}{diff_ignore_regex} . + '|(^|/)debian/patches/.dpkg-source-applied$', + include_removal => $self->{options}{include_removal}, + include_timestamp => $self->{options}{include_timestamp}, + use_dev_null => 1, + }; + push @{$self->{options}{tar_ignore}}, 'debian/patches/.dpkg-source-applied'; + $self->check_patches_applied($dir) if $self->{options}{preparation}; + if ($self->{options}{create_empty_orig} and + not $self->find_original_tarballs(include_supplementary => 0)) + { + # No main orig.tar, create a dummy one + my $filename = $self->get_basename() . '.orig.tar.' . + $self->{options}{comp_ext}; + my $tar = Dpkg::Source::Archive->new(filename => $filename, + compression_level => $self->{options}{comp_level}); + $tar->create(); + $tar->finish(); + } +} + +sub check_patches_applied { + my ($self, $dir) = @_; + my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied'); + unless (-e $applied) { + info(g_('patches are not applied, applying them now')); + $self->apply_patches($dir, usage => 'preparation'); + } +} + +sub _generate_patch { + my ($self, $dir, %opts) = @_; + my ($dirname, $updir) = fileparse($dir); + my $basedirname = $self->get_basename(); + $basedirname =~ s/_/-/; + + # Identify original tarballs + my ($tarfile, %addonfile); + my $comp_ext_regex = compression_get_file_extension_regex(); + my @origtarfiles; + my @origtarsigns; + foreach my $file (sort $self->find_original_tarballs()) { + if ($file =~ /\.orig\.tar\.$comp_ext_regex$/) { + if (defined($tarfile)) { + error(g_('several orig.tar files found (%s and %s) but only ' . + 'one is allowed'), $tarfile, $file); + } + $tarfile = $file; + } elsif ($file =~ /\.orig-([[:alnum:]-]+)\.tar\.$comp_ext_regex$/) { + $addonfile{$1} = $file; + } else { + next; + } + + push @origtarfiles, $file; + $self->add_file($file); + + # Check for an upstream signature. + if (-e "$file.sig" and not -e "$file.asc") { + $self->armor_original_tarball_signature("$file.sig", "$file.asc"); + } + if (-e "$file.asc") { + push @origtarfiles, "$file.asc"; + push @origtarsigns, "$file.asc"; + $self->add_file("$file.asc") + } + } + + error(g_('no upstream tarball found at %s'), + $self->_upstream_tarball_template()) unless $tarfile; + + if ($opts{usage} eq 'build') { + if (@origtarsigns) { + $self->check_original_tarball_signature($dir, @origtarsigns); + } else { + my $key = $self->get_upstream_signing_key($dir); + if (-e $key) { + warning(g_('upstream signing key but no upstream tarball signature')); + } + } + + foreach my $origtarfile (@origtarfiles) { + info(g_('building %s using existing %s'), + $self->{fields}{'Source'}, $origtarfile); + } + } + + # Unpack a second copy for comparison + my $tmp = tempdir("$dirname.orig.XXXXXX", DIR => $updir); + push_exit_handler(sub { erasedir($tmp) }); + + # Extract main tarball + my $tar = Dpkg::Source::Archive->new(filename => $tarfile); + $tar->extract($tmp); + + # Extract additional orig tarballs + foreach my $subdir (keys %addonfile) { + my $file = $addonfile{$subdir}; + $tar = Dpkg::Source::Archive->new(filename => $file); + $tar->extract("$tmp/$subdir"); + } + + # Copy over the debian directory + erasedir("$tmp/debian"); + system('cp', '-a', '--', "$dir/debian", "$tmp/"); + subprocerr(g_('copy of the debian directory')) if $?; + + # Apply all patches except the last automatic one + $opts{skip_auto} //= 0; + $self->apply_patches($tmp, skip_auto => $opts{skip_auto}, usage => 'build'); + + # Create a patch + my ($difffh, $tmpdiff) = tempfile($self->get_basename(1) . '.diff.XXXXXX', + TMPDIR => 1, UNLINK => 0); + push_exit_handler(sub { unlink($tmpdiff) }); + my $diff = Dpkg::Source::Patch->new(filename => $tmpdiff, + compression => 'none'); + $diff->create(); + $diff->set_header(sub { + if ($opts{header_from} and -e $opts{header_from}) { + my $header_from = Dpkg::Source::Patch->new( + filename => $opts{header_from}); + my $analysis = $header_from->analyze($dir, verbose => 0); + return $analysis->{patchheader}; + } else { + return $self->_get_patch_header($dir); + } + }); + $diff->add_diff_directory($tmp, $dir, basedirname => $basedirname, + %{$self->{diff_options}}, + handle_binary_func => $opts{handle_binary}, + order_from => $opts{order_from}); + error(g_('unrepresentable changes to source')) if not $diff->finish(); + + if (-s $tmpdiff) { + info(g_('local changes detected, the modified files are:')); + my $analysis = $diff->analyze($dir, verbose => 0); + foreach my $fn (sort keys %{$analysis->{filepatched}}) { + print " $fn\n"; + } + } + + # Remove the temporary directory + erasedir($tmp); + pop_exit_handler(); + pop_exit_handler(); + + return $tmpdiff; +} + +sub do_build { + my ($self, $dir) = @_; + my @argv = @{$self->{options}{ARGV}}; + if (scalar(@argv)) { + usageerr(g_("-b takes only one parameter with format '%s'"), + $self->{fields}{'Format'}); + } + $self->prepare_build($dir); + + my $include_binaries = $self->{options}{include_binaries}; + my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}}; + + my $sourcepackage = $self->{fields}{'Source'}; + my $basenamerev = $self->get_basename(1); + + # Check if the debian directory contains unwanted binary files + my $binaryfiles = Dpkg::Source::BinaryFiles->new($dir); + + $binaryfiles->detect_binary_files( + exclude_globs => $self->{options}{tar_ignore}, + include_binaries => $include_binaries, + ); + + # Handle modified binary files detected by the auto-patch generation + my $handle_binary = sub { + my ($self, $old, $new, %opts) = @_; + + my $file = $opts{filename}; + $binaryfiles->new_binary_found($file); + unless ($include_binaries or $binaryfiles->binary_is_allowed($file)) { + errormsg(g_('cannot represent change to %s: %s'), $file, + g_('binary file contents changed')); + errormsg(g_('add %s in debian/source/include-binaries if you want ' . + 'to store the modified binary in the debian tarball'), + $file); + $self->register_error(); + } + }; + + # Create a patch + my $autopatch = File::Spec->catfile($dir, 'debian', 'patches', + $self->get_autopatch_name()); + my $tmpdiff = $self->_generate_patch($dir, order_from => $autopatch, + header_from => $autopatch, + handle_binary => $handle_binary, + skip_auto => $self->{options}{auto_commit}, + usage => 'build'); + unless (-z $tmpdiff or $self->{options}{auto_commit}) { + info(g_('Hint: make sure the version in debian/changelog matches ' . + 'the unpacked source tree')); + info(g_('you can integrate the local changes with %s'), + 'dpkg-source --commit'); + error(g_('aborting due to unexpected upstream changes, see %s'), + $tmpdiff); + } + push_exit_handler(sub { unlink($tmpdiff) }); + $binaryfiles->update_debian_source_include_binaries() if $include_binaries; + + # Install the diff as the new autopatch + if ($self->{options}{auto_commit}) { + make_path(File::Spec->catdir($dir, 'debian', 'patches')); + $autopatch = $self->register_patch($dir, $tmpdiff, + $self->get_autopatch_name()); + info(g_('local changes have been recorded in a new patch: %s'), + $autopatch) if -e $autopatch; + rmdir(File::Spec->catdir($dir, 'debian', 'patches')); # No check on purpose + } + unlink($tmpdiff) or syserr(g_('cannot remove %s'), $tmpdiff); + pop_exit_handler(); + + # Create the debian.tar + my $debianfile = "$basenamerev.debian.tar." . $self->{options}{comp_ext}; + info(g_('building %s in %s'), $sourcepackage, $debianfile); + my $tar = Dpkg::Source::Archive->new(filename => $debianfile, + compression_level => $self->{options}{comp_level}); + $tar->create(options => \@tar_ignore, chdir => $dir); + $tar->add_directory('debian'); + foreach my $binary ($binaryfiles->get_seen_binaries()) { + $tar->add_file($binary) unless $binary =~ m{^debian/}; + } + $tar->finish(); + + $self->add_file($debianfile); +} + +sub _get_patch_header { + my ($self, $dir) = @_; + + my $ph = File::Spec->catfile($dir, 'debian', 'source', 'local-patch-header'); + unless (-f $ph) { + $ph = File::Spec->catfile($dir, 'debian', 'source', 'patch-header'); + } + if (-f $ph) { + return file_slurp($ph); + } + + if ($self->{options}->{single_debian_patch}) { + return <<'AUTOGEN_HEADER'; +Description: Autogenerated patch header for a single-debian-patch file. + The delta against upstream is either kept as a single patch, or maintained + in some VCS, and exported as a single patch instead of more manageable + atomic patches. +Forwarded: not-needed + +--- +AUTOGEN_HEADER + } + + my $ch_info = changelog_parse(offset => 0, count => 1, + file => $self->{options}{changelog_file}); + return '' if not defined $ch_info; + my $header = Dpkg::Control->new(type => CTRL_UNKNOWN); + $header->{'Description'} = "<short summary of the patch>\n"; + $header->{'Description'} .= +"TODO: Put a short summary on the line above and replace this paragraph +with a longer explanation of this change. Complete the meta-information +with other relevant fields (see below for details). To make it easier, the +information below has been extracted from the changelog. Adjust it or drop +it.\n"; + $header->{'Description'} .= $ch_info->{'Changes'} . "\n"; + $header->{'Author'} = $ch_info->{'Maintainer'}; + my $yyyy_mm_dd = POSIX::strftime('%Y-%m-%d', gmtime); + + my $text; + $text = "$header"; + run_vendor_hook('extend-patch-header', \$text, $ch_info); + $text .= "\n--- +The information above should follow the Patch Tagging Guidelines, please +checkout https://dep.debian.net/deps/dep3/ to learn about the format. Here +are templates for supplementary fields that you might want to add: + +Origin: (upstream|backport|vendor|other), (<patch-url>|commit:<commit-id>) +Bug: <upstream-bugtracker-url> +Bug-Debian: https://bugs.debian.org/<bugnumber> +Bug-Ubuntu: https://launchpad.net/bugs/<bugnumber> +Forwarded: (no|not-needed|<patch-forwarded-url>) +Applied-Upstream: <version>, (<commit-url>|commit:<commid-id>) +Reviewed-By: <name and email of someone who approved/reviewed the patch> +Last-Update: $yyyy_mm_dd\n\n"; + return $text; +} + +sub register_patch { + my ($self, $dir, $patch_file, $patch_name) = @_; + my $patch = File::Spec->catfile($dir, 'debian', 'patches', $patch_name); + if (-s $patch_file) { + copy($patch_file, $patch) + or syserr(g_('failed to copy %s to %s'), $patch_file, $patch); + chmod_if_needed(0666 & ~ umask(), $patch) + or syserr(g_("unable to change permission of '%s'"), $patch); + my $applied = File::Spec->catfile($dir, 'debian', 'patches', '.dpkg-source-applied'); + open(my $applied_fh, '>>', $applied) + or syserr(g_('cannot write %s'), $applied); + print { $applied_fh } "$patch\n"; + close($applied_fh) or syserr(g_('cannot close %s'), $applied); + } elsif (-e $patch) { + unlink($patch) or syserr(g_('cannot remove %s'), $patch); + } + return $patch; +} + +sub _is_bad_patch_name { + my ($dir, $patch_name) = @_; + + return 1 if not defined($patch_name); + return 1 if not length($patch_name); + + my $patch = File::Spec->catfile($dir, 'debian', 'patches', $patch_name); + if (-e $patch) { + warning(g_('cannot register changes in %s, this patch already exists'), + $patch); + return 1; + } + return 0; +} + +sub do_commit { + my ($self, $dir) = @_; + my ($patch_name, $tmpdiff) = @{$self->{options}{ARGV}}; + + $self->prepare_build($dir); + + # Try to fix up a broken relative filename for the patch + if ($tmpdiff and not -e $tmpdiff) { + $tmpdiff = File::Spec->catfile($dir, $tmpdiff) + unless File::Spec->file_name_is_absolute($tmpdiff); + error(g_("patch file '%s' doesn't exist"), $tmpdiff) if not -e $tmpdiff; + } + + my $binaryfiles = Dpkg::Source::BinaryFiles->new($dir); + my $handle_binary = sub { + my ($self, $old, $new, %opts) = @_; + my $fn = File::Spec->abs2rel($new, $dir); + $binaryfiles->new_binary_found($fn); + }; + + unless ($tmpdiff) { + $tmpdiff = $self->_generate_patch($dir, handle_binary => $handle_binary, + usage => 'commit'); + $binaryfiles->update_debian_source_include_binaries(); + } + push_exit_handler(sub { unlink($tmpdiff) }); + unless (-s $tmpdiff) { + unlink($tmpdiff) or syserr(g_('cannot remove %s'), $tmpdiff); + info(g_('there are no local changes to record')); + return; + } + while (_is_bad_patch_name($dir, $patch_name)) { + # Ask the patch name interactively + print g_('Enter the desired patch name: '); + $patch_name = <STDIN>; + if (not defined $patch_name) { + error(g_('no patch name given; cannot proceed')); + } + chomp $patch_name; + $patch_name =~ s/\s+/-/g; + $patch_name =~ s/\///g; + } + make_path(File::Spec->catdir($dir, 'debian', 'patches')); + my $patch = $self->register_patch($dir, $tmpdiff, $patch_name); + my @editors = ('sensible-editor', $ENV{VISUAL}, $ENV{EDITOR}, 'vi'); + my $editor = first { find_command($_) } @editors; + if (not $editor) { + error(g_('cannot find an editor')); + } + system($editor, $patch); + subprocerr($editor) if $?; + unlink($tmpdiff) or syserr(g_('cannot remove %s'), $tmpdiff); + pop_exit_handler(); + info(g_('local changes have been recorded in a new patch: %s'), $patch); +} + +=head1 CHANGES + +=head2 Version 0.xx + +This is a private module. + +=cut + +1; diff --git a/scripts/Dpkg/Source/Package/V3/Bzr.pm b/scripts/Dpkg/Source/Package/V3/Bzr.pm new file mode 100644 index 0000000..adc5fda --- /dev/null +++ b/scripts/Dpkg/Source/Package/V3/Bzr.pm @@ -0,0 +1,230 @@ +# Copyright © 2007 Colin Watson <cjwatson@debian.org>. +# Based on Dpkg::Source::Package::V3_0::git, which is: +# Copyright © 2007 Joey Hess <joeyh@debian.org>. +# Copyright © 2008 Frank Lichtenheld <djpig@debian.org> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <https://www.gnu.org/licenses/>. + +=encoding utf8 + +=head1 NAME + +Dpkg::Source::Package::V3::Bzr - class for source format 3.0 (bzr) + +=head1 DESCRIPTION + +This module provides a class to handle the source package format 3.0 (bzr). + +B<Note>: This is a private module, its API can change at any time. + +=cut + +package Dpkg::Source::Package::V3::Bzr 0.01; + +use strict; +use warnings; + +use Cwd; +use File::Basename; +use File::Spec; +use File::Find; +use File::Temp qw(tempdir); + +use Dpkg::Gettext; +use Dpkg::Compression; +use Dpkg::ErrorHandling; +use Dpkg::Source::Archive; +use Dpkg::Exit qw(push_exit_handler pop_exit_handler); +use Dpkg::Path qw(find_command); +use Dpkg::Source::Functions qw(erasedir); + +use parent qw(Dpkg::Source::Package); + +our $CURRENT_MINOR_VERSION = '0'; + +sub prerequisites { + return 1 if find_command('bzr'); + error(g_('cannot unpack bzr-format source package because ' . + 'bzr is not in the PATH')); +} + +sub _check_workdir { + my $srcdir = shift; + + if (! -d "$srcdir/.bzr") { + error(g_('source directory is not the top directory of a bzr repository (%s/.bzr not present), but Format bzr was specified'), + $srcdir); + } + + # Symlinks from .bzr to outside could cause unpack failures, or + # point to files they shouldn't, so check for and don't allow. + if (-l "$srcdir/.bzr") { + error(g_('%s is a symlink'), "$srcdir/.bzr"); + } + my $abs_srcdir = Cwd::abs_path($srcdir); + find(sub { + if (-l) { + if (Cwd::abs_path(readlink) !~ /^\Q$abs_srcdir\E(?:\/|$)/) { + error(g_('%s is a symlink to outside %s'), + $File::Find::name, $srcdir); + } + } + }, "$srcdir/.bzr"); + + return 1; +} + +sub can_build { + my ($self, $dir) = @_; + + return (0, g_("doesn't contain a bzr repository")) unless -d "$dir/.bzr"; + return 1; +} + +sub do_build { + my ($self, $dir) = @_; + my @argv = @{$self->{options}{ARGV}}; + # TODO: warn here? + #my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}}; + my $diff_ignore_regex = $self->{options}{diff_ignore_regex}; + + $dir =~ s{/+$}{}; # Strip trailing / + my ($dirname, $updir) = fileparse($dir); + + if (scalar(@argv)) { + usageerr(g_("-b takes only one parameter with format '%s'"), + $self->{fields}{'Format'}); + } + + my $sourcepackage = $self->{fields}{'Source'}; + my $basenamerev = $self->get_basename(1); + my $basename = $self->get_basename(); + my $basedirname = $basename; + $basedirname =~ s/_/-/; + + _check_workdir($dir); + + my $old_cwd = getcwd(); + chdir $dir or syserr(g_("unable to chdir to '%s'"), $dir); + + local $_; + + # Check for uncommitted files. + # To support dpkg-source -i, remove any ignored files from the + # output of bzr status. + open(my $bzr_status_fh, '-|', 'bzr', 'status') + or subprocerr('bzr status'); + my @files; + while (<$bzr_status_fh>) { + chomp; + next unless s/^ +//; + if (! length $diff_ignore_regex || + ! m/$diff_ignore_regex/o) { + push @files, $_; + } + } + close($bzr_status_fh) or syserr(g_('bzr status exited nonzero')); + if (@files) { + error(g_('uncommitted, not-ignored changes in working directory: %s'), + join(' ', @files)); + } + + chdir $old_cwd or syserr(g_("unable to chdir to '%s'"), $old_cwd); + + my $tmp = tempdir("$dirname.bzr.XXXXXX", DIR => $updir); + push_exit_handler(sub { erasedir($tmp) }); + my $tardir = "$tmp/$dirname"; + + system('bzr', 'branch', $dir, $tardir); + subprocerr("bzr branch $dir $tardir") if $?; + + # Remove the working tree. + system('bzr', 'remove-tree', $tardir); + subprocerr("bzr remove-tree $tardir") if $?; + + # Some branch metadata files are unhelpful. + unlink("$tardir/.bzr/branch/branch-name", + "$tardir/.bzr/branch/parent"); + + # Create the tar file + my $debianfile = "$basenamerev.bzr.tar." . $self->{options}{comp_ext}; + info(g_('building %s in %s'), + $sourcepackage, $debianfile); + my $tar = Dpkg::Source::Archive->new(filename => $debianfile, + compression => $self->{options}{compression}, + compression_level => $self->{options}{comp_level}); + $tar->create(chdir => $tmp); + $tar->add_directory($dirname); + $tar->finish(); + + erasedir($tmp); + pop_exit_handler(); + + $self->add_file($debianfile); +} + +# Called after a tarball is unpacked, to check out the working copy. +sub do_extract { + my ($self, $newdirectory) = @_; + my $fields = $self->{fields}; + + my $basename = $self->get_basename(); + my $basenamerev = $self->get_basename(1); + + my @files = $self->get_files(); + if (@files > 1) { + error(g_('format v3.0 (bzr) uses only one source file')); + } + my $tarfile = $files[0]; + my $comp_ext_regex = compression_get_file_extension_regex(); + if ($tarfile !~ /^\Q$basenamerev\E\.bzr\.tar\.$comp_ext_regex$/) { + error(g_('expected %s, got %s'), + "$basenamerev.bzr.tar.$comp_ext_regex", $tarfile); + } + + if ($self->{options}{no_overwrite_dir} and -e $newdirectory) { + error(g_('unpack target exists: %s'), $newdirectory); + } else { + erasedir($newdirectory); + } + + # Extract main tarball + info(g_('unpacking %s'), $tarfile); + my $tar = Dpkg::Source::Archive->new( + filename => File::Spec->catfile($self->{basedir}, $tarfile), + ); + $tar->extract($newdirectory); + + _check_workdir($newdirectory); + + my $old_cwd = getcwd(); + chdir($newdirectory) + or syserr(g_("unable to chdir to '%s'"), $newdirectory); + + # Reconstitute the working tree. + system('bzr', 'checkout'); + subprocerr('bzr checkout') if $?; + + chdir $old_cwd or syserr(g_("unable to chdir to '%s'"), $old_cwd); +} + +=head1 CHANGES + +=head2 Version 0.xx + +This is a private module. + +=cut + +1; diff --git a/scripts/Dpkg/Source/Package/V3/Custom.pm b/scripts/Dpkg/Source/Package/V3/Custom.pm new file mode 100644 index 0000000..5ef1e4f --- /dev/null +++ b/scripts/Dpkg/Source/Package/V3/Custom.pm @@ -0,0 +1,95 @@ +# Copyright © 2008 Raphaël Hertzog <hertzog@debian.org> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <https://www.gnu.org/licenses/>. + +=encoding utf8 + +=head1 NAME + +Dpkg::Source::Package::V3::Custom - class for source format 3.0 (custom) + +=head1 DESCRIPTION + +This module provides a class to handle the pseudo source package +format 3.0 (custom). + +B<Note>: This is a private module, its API can change at any time. + +=cut + +package Dpkg::Source::Package::V3::Custom 0.01; + +use strict; +use warnings; + +use Dpkg::Gettext; +use Dpkg::ErrorHandling; + +use parent qw(Dpkg::Source::Package); + +our $CURRENT_MINOR_VERSION = '0'; + +my @module_cmdline = ( + { + name => '--target-format=<value>', + help => N_('define the format of the generated source package'), + when => 'build', + } +); + +sub describe_cmdline_options { + return @module_cmdline; +} + +sub parse_cmdline_option { + my ($self, $opt) = @_; + if ($opt =~ /^--target-format=(.*)$/) { + $self->{options}{target_format} = $1; + return 1; + } + return 0; +} +sub do_extract { + error(g_("Format '3.0 (custom)' is only used to create source packages")); +} + +sub can_build { + my ($self, $dir) = @_; + + return (0, g_('no files indicated on command line')) + unless scalar(@{$self->{options}{ARGV}}); + return 1; +} + +sub do_build { + my ($self, $dir) = @_; + # Update real target format + my $format = $self->{options}{target_format}; + error(g_('--target-format option is missing')) unless $format; + $self->{fields}{'Format'} = $format; + # Add all files + foreach my $file (@{$self->{options}{ARGV}}) { + $self->add_file($file); + } +} + +=head1 CHANGES + +=head2 Version 0.xx + +This is a private module. + +=cut + +1; diff --git a/scripts/Dpkg/Source/Package/V3/Git.pm b/scripts/Dpkg/Source/Package/V3/Git.pm new file mode 100644 index 0000000..01f708d --- /dev/null +++ b/scripts/Dpkg/Source/Package/V3/Git.pm @@ -0,0 +1,300 @@ +# Copyright © 2007,2010 Joey Hess <joeyh@debian.org>. +# Copyright © 2008 Frank Lichtenheld <djpig@debian.org> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <https://www.gnu.org/licenses/>. + +=encoding utf8 + +=head1 NAME + +Dpkg::Source::Package::V3::Git - class for source format 3.0 (git) + +=head1 DESCRIPTION + +This module provides a class to handle the source package format 3.0 (git). + +B<Note>: This is a private module, its API can change at any time. + +=cut + +package Dpkg::Source::Package::V3::Git 0.02; + +use strict; +use warnings; + +use Cwd qw(abs_path getcwd); +use File::Basename; +use File::Spec; +use File::Temp qw(tempdir); + +use Dpkg::Gettext; +use Dpkg::ErrorHandling; +use Dpkg::Exit qw(push_exit_handler pop_exit_handler); +use Dpkg::Path qw(find_command); +use Dpkg::Source::Functions qw(erasedir); + +use parent qw(Dpkg::Source::Package); + +our $CURRENT_MINOR_VERSION = '0'; + +# Remove variables from the environment that might cause git to do +# something unexpected. +delete $ENV{GIT_DIR}; +delete $ENV{GIT_INDEX_FILE}; +delete $ENV{GIT_OBJECT_DIRECTORY}; +delete $ENV{GIT_ALTERNATE_OBJECT_DIRECTORIES}; +delete $ENV{GIT_WORK_TREE}; + +sub prerequisites { + return 1 if find_command('git'); + error(g_('cannot unpack git-format source package because ' . + 'git is not in the PATH')); +} + +sub _check_workdir { + my $srcdir = shift; + + if (! -d "$srcdir/.git") { + error(g_('source directory is not the top directory of a git ' . + 'repository (%s/.git not present), but Format git was ' . + 'specified'), $srcdir); + } + if (-s "$srcdir/.gitmodules") { + error(g_('git repository %s uses submodules; this is not yet supported'), + $srcdir); + } + + return 1; +} + +sub _parse_vcs_git { + my $vcs_git = shift; + my ($url, $opt, $branch) = split ' ', $vcs_git; + + if (defined $opt && $opt eq '-b' && defined $branch) { + return ($url, $branch); + } else { + return ($url); + } +} + +my @module_cmdline = ( + { + name => '--git-ref=<ref>', + help => N_('specify a git <ref> to include in the git bundle'), + when => 'build', + }, { + name => '--git-depth=<number>', + help => N_('create a shallow clone with <number> depth'), + when => 'build', + } +); + +sub describe_cmdline_options { + my $self = shift; + + my @cmdline = ( $self->SUPER::describe_cmdline_options(), @module_cmdline ); + + return @cmdline; +} + +sub parse_cmdline_option { + my ($self, $opt) = @_; + return 1 if $self->SUPER::parse_cmdline_option($opt); + if ($opt =~ /^--git-ref=(.*)$/) { + push @{$self->{options}{git_ref}}, $1; + return 1; + } elsif ($opt =~ /^--git-depth=(\d+)$/) { + $self->{options}{git_depth} = $1; + return 1; + } + return 0; +} + +sub can_build { + my ($self, $dir) = @_; + + return (0, g_("doesn't contain a git repository")) unless -d "$dir/.git"; + return 1; +} + +sub do_build { + my ($self, $dir) = @_; + my $diff_ignore_regex = $self->{options}{diff_ignore_regex}; + + $dir =~ s{/+$}{}; # Strip trailing / + my ($dirname, $updir) = fileparse($dir); + my $basenamerev = $self->get_basename(1); + + _check_workdir($dir); + + my $old_cwd = getcwd(); + chdir $dir or syserr(g_("unable to chdir to '%s'"), $dir); + + # Check for uncommitted files. + # To support dpkg-source -i, get a list of files + # equivalent to the ones git status finds, and remove any + # ignored files from it. + my @ignores = '--exclude-per-directory=.gitignore'; + my $core_excludesfile = qx(git config --get core.excludesfile); + chomp $core_excludesfile; + if (length $core_excludesfile && -e $core_excludesfile) { + push @ignores, "--exclude-from=$core_excludesfile"; + } + if (-e '.git/info/exclude') { + push @ignores, '--exclude-from=.git/info/exclude'; + } + open(my $git_ls_files_fh, '-|', 'git', 'ls-files', '--modified', '--deleted', + '-z', '--others', @ignores) or subprocerr('git ls-files'); + my @files; + { + local $_; + local $/ = "\0"; + while (<$git_ls_files_fh>) { + chomp; + if (! length $diff_ignore_regex || + ! m/$diff_ignore_regex/o) { + push @files, $_; + } + } + } + close($git_ls_files_fh) or syserr(g_('git ls-files exited nonzero')); + if (@files) { + error(g_('uncommitted, not-ignored changes in working directory: %s'), + join(' ', @files)); + } + + # If a depth was specified, need to create a shallow clone and + # bundle that. + my $tmp; + my $shallowfile; + if ($self->{options}{git_depth}) { + chdir $old_cwd or syserr(g_("unable to chdir to '%s'"), $old_cwd); + $tmp = tempdir("$dirname.git.XXXXXX", DIR => $updir); + push_exit_handler(sub { erasedir($tmp) }); + my $clone_dir = "$tmp/repo.git"; + # file:// is needed to avoid local cloning, which does not + # create a shallow clone. + info(g_('creating shallow clone with depth %s'), + $self->{options}{git_depth}); + system('git', 'clone', '--depth=' . $self->{options}{git_depth}, + '--quiet', '--bare', 'file://' . abs_path($dir), $clone_dir); + subprocerr('git clone') if $?; + chdir($clone_dir) + or syserr(g_("unable to chdir to '%s'"), $clone_dir); + $shallowfile = "$basenamerev.gitshallow"; + system('cp', '-f', 'shallow', "$old_cwd/$shallowfile"); + subprocerr('cp shallow') if $?; + } + + # Create the git bundle. + my $bundlefile = "$basenamerev.git"; + my @bundle_arg = $self->{options}{git_ref} ? + (@{$self->{options}{git_ref}}) : '--all'; + info(g_('bundling: %s'), join(' ', @bundle_arg)); + system('git', 'bundle', 'create', "$old_cwd/$bundlefile", + @bundle_arg, + 'HEAD', # ensure HEAD is included no matter what + '--', # avoids ambiguity error when referring to eg, a debian branch + ); + subprocerr('git bundle') if $?; + + chdir $old_cwd or syserr(g_("unable to chdir to '%s'"), $old_cwd); + + if (defined $tmp) { + erasedir($tmp); + pop_exit_handler(); + } + + $self->add_file($bundlefile); + if (defined $shallowfile) { + $self->add_file($shallowfile); + } +} + +sub do_extract { + my ($self, $newdirectory) = @_; + my $fields = $self->{fields}; + + my $basenamerev = $self->get_basename(1); + + my @files = $self->get_files(); + my ($bundle, $shallow); + foreach my $file (@files) { + if ($file =~ /^\Q$basenamerev\E\.git$/) { + if (! defined $bundle) { + $bundle = $file; + } else { + error(g_('format v3.0 (git) uses only one .git file')); + } + } elsif ($file =~ /^\Q$basenamerev\E\.gitshallow$/) { + if (! defined $shallow) { + $shallow = $file; + } else { + error(g_('format v3.0 (git) uses only one .gitshallow file')); + } + } else { + error(g_('format v3.0 (git) unknown file: %s'), $file); + } + } + if (! defined $bundle) { + error(g_('format v3.0 (git) expected %s'), "$basenamerev.git"); + } + + if ($self->{options}{no_overwrite_dir} and -e $newdirectory) { + error(g_('unpack target exists: %s'), $newdirectory); + } else { + erasedir($newdirectory); + } + + # Extract git bundle. + info(g_('cloning %s'), $bundle); + my $bundle_path = File::Spec->catfile($self->{basedir}, $bundle); + system('git', 'clone', '--quiet', '--origin=bundle', $bundle_path, $newdirectory); + subprocerr('git bundle') if $?; + + if (defined $shallow) { + # Move shallow info file into place, so git does not + # try to follow parents of shallow refs. + info(g_('setting up shallow clone')); + my $shallow_orig = File::Spec->catfile($self->{basedir}, $shallow); + my $shallow_dest = File::Spec->catfile($newdirectory, '.git', 'shallow'); + system('cp', '-f', $shallow_orig, $shallow_dest); + subprocerr('cp') if $?; + } + + _check_workdir($newdirectory); + + if (defined $fields->{'Vcs-Git'}) { + my $remote = 'origin'; + my ($url, $head) = _parse_vcs_git($fields->{'Vcs-Git'}); + + my @git_remote_add = (qw(git -C), $newdirectory, qw(remote add)); + push @git_remote_add, '-m', $head if defined $head; + + info(g_('setting remote %s to %s'), $remote, $url); + system(@git_remote_add, $remote, $url); + subprocerr('git remote add') if $?; + } +} + +=head1 CHANGES + +=head2 Version 0.xx + +This is a private module. + +=cut + +1; diff --git a/scripts/Dpkg/Source/Package/V3/Native.pm b/scripts/Dpkg/Source/Package/V3/Native.pm new file mode 100644 index 0000000..80debf5 --- /dev/null +++ b/scripts/Dpkg/Source/Package/V3/Native.pm @@ -0,0 +1,141 @@ +# Copyright © 2008 Raphaël Hertzog <hertzog@debian.org> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <https://www.gnu.org/licenses/>. + +=encoding utf8 + +=head1 NAME + +Dpkg::Source::Package::V3::Native - class for source format 3.0 (native) + +=head1 DESCRIPTION + +This module provides a class to handle the source package format 3.0 (native). + +B<Note>: This is a private module, its API can change at any time. + +=cut + +package Dpkg::Source::Package::V3::Native 0.01; + +use strict; +use warnings; + +use Cwd; +use File::Basename; +use File::Spec; +use File::Temp qw(tempfile); + +use Dpkg::Gettext; +use Dpkg::ErrorHandling; +use Dpkg::Compression; +use Dpkg::Exit qw(push_exit_handler pop_exit_handler); +use Dpkg::Version; +use Dpkg::Source::Archive; +use Dpkg::Source::Functions qw(erasedir); + +use parent qw(Dpkg::Source::Package); + +our $CURRENT_MINOR_VERSION = '0'; + +sub do_extract { + my ($self, $newdirectory) = @_; + my $sourcestyle = $self->{options}{sourcestyle}; + my $fields = $self->{fields}; + + my $basename = $self->get_basename(); + my $basenamerev = $self->get_basename(1); + + my $tarfile; + my $comp_ext_regex = compression_get_file_extension_regex(); + foreach my $file ($self->get_files()) { + if ($file =~ /^\Q$basenamerev\E\.tar\.$comp_ext_regex$/) { + error(g_('multiple tarfiles in native source package')) if $tarfile; + $tarfile = $file; + } else { + error(g_('unrecognized file for a native source package: %s'), $file); + } + } + + error(g_('no tarfile in Files field')) unless $tarfile; + + if ($self->{options}{no_overwrite_dir} and -e $newdirectory) { + error(g_('unpack target exists: %s'), $newdirectory); + } else { + erasedir($newdirectory); + } + + info(g_('unpacking %s'), $tarfile); + my $tar = Dpkg::Source::Archive->new( + filename => File::Spec->catfile($self->{basedir}, $tarfile), + ); + $tar->extract($newdirectory); +} + +sub can_build { + my ($self, $dir) = @_; + + my $v = Dpkg::Version->new($self->{fields}->{'Version'}); + return (0, g_('native package version may not have a revision')) + unless $v->is_native(); + + return 1; +} + +sub do_build { + my ($self, $dir) = @_; + my @tar_ignore = map { "--exclude=$_" } @{$self->{options}{tar_ignore}}; + my @argv = @{$self->{options}{ARGV}}; + + if (scalar(@argv)) { + usageerr(g_("-b takes only one parameter with format '%s'"), + $self->{fields}{'Format'}); + } + + my $sourcepackage = $self->{fields}{'Source'}; + my $basenamerev = $self->get_basename(1); + my $tarname = "$basenamerev.tar." . $self->{options}{comp_ext}; + + info(g_('building %s in %s'), $sourcepackage, $tarname); + + my ($ntfh, $newtar) = tempfile("$tarname.new.XXXXXX", + DIR => getcwd(), UNLINK => 0); + push_exit_handler(sub { unlink($newtar) }); + + my ($dirname, $dirbase) = fileparse($dir); + my $tar = Dpkg::Source::Archive->new(filename => $newtar, + compression => compression_guess_from_filename($tarname), + compression_level => $self->{options}{comp_level}); + $tar->create(options => \@tar_ignore, chdir => $dirbase); + $tar->add_directory($dirname); + $tar->finish(); + rename($newtar, $tarname) + or syserr(g_("unable to rename '%s' (newly created) to '%s'"), + $newtar, $tarname); + pop_exit_handler(); + chmod(0666 &~ umask(), $tarname) + or syserr(g_("unable to change permission of '%s'"), $tarname); + + $self->add_file($tarname); +} + +=head1 CHANGES + +=head2 Version 0.xx + +This is a private module. + +=cut + +1; diff --git a/scripts/Dpkg/Source/Package/V3/Quilt.pm b/scripts/Dpkg/Source/Package/V3/Quilt.pm new file mode 100644 index 0000000..663d021 --- /dev/null +++ b/scripts/Dpkg/Source/Package/V3/Quilt.pm @@ -0,0 +1,289 @@ +# Copyright © 2008-2012 Raphaël Hertzog <hertzog@debian.org> +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see <https://www.gnu.org/licenses/>. + +=encoding utf8 + +=head1 NAME + +Dpkg::Source::Package::V3::Quilt - class for source format 3.0 (quilt) + +=head1 DESCRIPTION + +This module provides a class to handle the source package format 3.0 (quilt). + +B<Note>: This is a private module, its API can change at any time. + +=cut + +package Dpkg::Source::Package::V3::Quilt 0.01; + +use strict; +use warnings; + +use List::Util qw(any); +use File::Spec; +use File::Copy; + +use Dpkg::Gettext; +use Dpkg::ErrorHandling; +use Dpkg::File; +use Dpkg::Version; +use Dpkg::Source::Patch; +use Dpkg::Source::Functions qw(erasedir chmod_if_needed fs_time); +use Dpkg::Source::Quilt; +use Dpkg::Exit; + +# Based on wig&pen implementation +use parent qw(Dpkg::Source::Package::V2); + +our $CURRENT_MINOR_VERSION = '0'; + +sub init_options { + my $self = shift; + $self->{options}{single_debian_patch} //= 0; + $self->{options}{allow_version_of_quilt_db} //= []; + + $self->SUPER::init_options(); +} + +my @module_cmdline = ( + { + name => '--single-debian-patch', + help => N_('use a single debianization patch'), + when => 'build', + }, { + name => '--allow-version-of-quilt-db=<version>', + help => N_('accept quilt metadata <version> even if unknown'), + when => 'build', + } +); + +sub describe_cmdline_options { + my $self = shift; + + my @cmdline = ( $self->SUPER::describe_cmdline_options(), @module_cmdline ); + + return @cmdline; +} + +sub parse_cmdline_option { + my ($self, $opt) = @_; + return 1 if $self->SUPER::parse_cmdline_option($opt); + if ($opt eq '--single-debian-patch') { + $self->{options}{single_debian_patch} = 1; + # For backwards compatibility. + $self->{options}{auto_commit} = 1; + return 1; + } elsif ($opt =~ /^--allow-version-of-quilt-db=(.*)$/) { + push @{$self->{options}{allow_version_of_quilt_db}}, $1; + return 1; + } + return 0; +} + +sub _build_quilt_object { + my ($self, $dir) = @_; + return $self->{quilt}{$dir} if exists $self->{quilt}{$dir}; + $self->{quilt}{$dir} = Dpkg::Source::Quilt->new($dir); + return $self->{quilt}{$dir}; +} + +sub can_build { + my ($self, $dir) = @_; + my ($code, $msg) = $self->SUPER::can_build($dir); + return ($code, $msg) if $code == 0; + + my $v = Dpkg::Version->new($self->{fields}->{'Version'}); + return (0, g_('non-native package version does not contain a revision')) + if $v->is_native(); + + my $quilt = $self->_build_quilt_object($dir); + $msg = $quilt->find_problems(); + return (0, $msg) if $msg; + return 1; +} + +sub get_autopatch_name { + my $self = shift; + if ($self->{options}{single_debian_patch}) { + return 'debian-changes'; + } else { + return 'debian-changes-' . $self->{fields}{'Version'}; + } +} + +sub apply_patches { + my ($self, $dir, %opts) = @_; + + if ($opts{usage} eq 'unpack') { + $opts{verbose} = 1; + } elsif ($opts{usage} eq 'build') { + $opts{warn_options} = 1; + $opts{verbose} = 0; + } + + my $quilt = $self->_build_quilt_object($dir); + $quilt->load_series(%opts) if $opts{warn_options}; # Trigger warnings + + # Always create the quilt db so that if the maintainer calls quilt to + # create a patch, it's stored in the right directory + $quilt->save_db(); + + # Update debian/patches/series symlink if needed to allow quilt usage + my $series = $quilt->get_series_file(); + my $basename = (File::Spec->splitpath($series))[2]; + if ($basename ne 'series') { + my $dest = $quilt->get_patch_file('series'); + unlink($dest) if -l $dest; + unless (-f _) { # Don't overwrite real files + symlink($basename, $dest) + or syserr(g_("can't create symlink %s"), $dest); + } + } + + return unless scalar($quilt->series()); + + info(g_('using patch list from %s'), "debian/patches/$basename"); + + if ($opts{usage} eq 'preparation' and + $self->{options}{unapply_patches} eq 'auto') { + # We're applying the patches in --before-build, remember to unapply + # them afterwards in --after-build + my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply'); + file_touch($pc_unapply); + } + + # Apply patches + my $pc_applied = $quilt->get_db_file('applied-patches'); + $opts{timestamp} = fs_time($pc_applied); + if ($opts{skip_auto}) { + my $auto_patch = $self->get_autopatch_name(); + $quilt->push(%opts) while ($quilt->next() and $quilt->next() ne $auto_patch); + } else { + $quilt->push(%opts) while $quilt->next(); + } +} + +sub unapply_patches { + my ($self, $dir, %opts) = @_; + + my $quilt = $self->_build_quilt_object($dir); + + $opts{verbose} //= 1; + + my $pc_applied = $quilt->get_db_file('applied-patches'); + my @applied = $quilt->applied(); + $opts{timestamp} = fs_time($pc_applied) if @applied; + + $quilt->pop(%opts) while $quilt->top(); + + erasedir($quilt->get_db_dir()); +} + +sub prepare_build { + my ($self, $dir) = @_; + $self->SUPER::prepare_build($dir); + # Skip .pc directories of quilt by default and ignore difference + # on debian/patches/series symlinks and d/p/.dpkg-source-applied + # stamp file created by ourselves + my $func = sub { + my $pathname = shift; + + return 1 if $pathname eq 'debian/patches/series' and -l $pathname; + return 1 if $pathname =~ /^\.pc(\/|$)/; + return 1 if $pathname =~ /$self->{options}{diff_ignore_regex}/; + return 0; + }; + $self->{diff_options}{diff_ignore_func} = $func; +} + +sub do_build { + my ($self, $dir) = @_; + + my $quilt = $self->_build_quilt_object($dir); + my $version = $quilt->get_db_version(); + + if (defined($version) and $version != 2) { + if (any { $version eq $_ } + @{$self->{options}{allow_version_of_quilt_db}}) + { + warning(g_('unsupported version of the quilt metadata: %s'), $version); + } else { + error(g_('unsupported version of the quilt metadata: %s'), $version); + } + } + + $self->SUPER::do_build($dir); +} + +sub after_build { + my ($self, $dir) = @_; + my $quilt = $self->_build_quilt_object($dir); + my $pc_unapply = $quilt->get_db_file('.dpkg-source-unapply'); + my $opt_unapply = $self->{options}{unapply_patches}; + if (($opt_unapply eq 'auto' and -e $pc_unapply) or $opt_unapply eq 'yes') { + unlink($pc_unapply); + $self->unapply_patches($dir); + } +} + +sub check_patches_applied { + my ($self, $dir) = @_; + + my $quilt = $self->_build_quilt_object($dir); + my $next = $quilt->next(); + return if not defined $next; + + my $first_patch = File::Spec->catfile($dir, 'debian', 'patches', $next); + my $patch_obj = Dpkg::Source::Patch->new(filename => $first_patch); + return unless $patch_obj->check_apply($dir, fatal_dupes => 1); + + $self->apply_patches($dir, usage => 'preparation', verbose => 1); +} + +sub register_patch { + my ($self, $dir, $tmpdiff, $patch_name) = @_; + + my $quilt = $self->_build_quilt_object($dir); + my $patch = $quilt->get_patch_file($patch_name); + + if (-s $tmpdiff) { + copy($tmpdiff, $patch) + or syserr(g_('failed to copy %s to %s'), $tmpdiff, $patch); + chmod_if_needed(0666 & ~ umask(), $patch) + or syserr(g_("unable to change permission of '%s'"), $patch); + } elsif (-e $patch) { + unlink($patch) or syserr(g_('cannot remove %s'), $patch); + } + + if (-e $patch) { + # Add patch to series file + $quilt->register($patch_name); + } else { + # Remove auto_patch from series + $quilt->unregister($patch_name); + } + return $patch; +} + +=head1 CHANGES + +=head2 Version 0.xx + +This is a private module. + +=cut + +1; |