| Server IP : 79.136.114.73 / Your IP : 216.73.216.107 Web Server : Apache/2.4.7 (Ubuntu) PHP/5.5.9-1ubuntu4.29 OpenSSL/1.0.1f System : Linux b8009 3.13.0-170-generic #220-Ubuntu SMP Thu May 9 12:40:49 UTC 2019 x86_64 User : www-data ( 33) PHP Version : 5.5.9-1ubuntu4.29 Disable Function : pcntl_alarm,pcntl_fork,pcntl_waitpid,pcntl_wait,pcntl_wifexited,pcntl_wifstopped,pcntl_wifsignaled,pcntl_wexitstatus,pcntl_wtermsig,pcntl_wstopsig,pcntl_signal,pcntl_signal_dispatch,pcntl_get_last_error,pcntl_strerror,pcntl_sigprocmask,pcntl_sigwaitinfo,pcntl_sigtimedwait,pcntl_exec,pcntl_getpriority,pcntl_setpriority, MySQL : ON | cURL : ON | WGET : ON | Perl : ON | Python : ON | Sudo : ON | Pkexec : ON Directory : /usr/share/perl5/Dpkg/Source/Package/ |
Upload File : |
# Copyright © 2008-2009 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/>.
package Dpkg::Source::Package::V1;
use strict;
use warnings;
our $VERSION = '0.01';
use parent qw(Dpkg::Source::Package);
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 POSIX qw(:errno_h);
use Cwd;
use File::Basename;
use File::Temp qw(tempfile);
use File::Spec;
our $CURRENT_MINOR_VERSION = '0';
sub init_options {
my ($self) = @_;
# 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-.*$';
}
push @{$self->{options}{tar_ignore}}, 'debian/source/local-options',
'debian/source/local-patch-header';
$self->{options}{sourcestyle} ||= 'X';
$self->{options}{skip_debianization} ||= 0;
$self->{options}{abort_on_upstream_changes} ||= 0;
}
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 =~ m/^--skip-debianization$/) {
$o->{skip_debianization} = 1;
return 1;
} elsif ($opt =~ m/^--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 $dscdir = $self->{basedir};
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';
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 => "$dscdir$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 = "$dscdir$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 ($dirname, $dirbase) = fileparse($dir);
if ($dirname ne $basedirname) {
warning(_g("source directory '%s' is not <sourcepackage>" .
"-<upstreamversion> '%s'"), $dir, $basedirname);
}
my ($tarname, $tardirname, $tardirbase);
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";
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/[nurUR]/) {
if (stat($tarname)) {
unless ($sourcestyle =~ m/[nUR]/) {
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);
}
$self->add_file($tarname) if $tarname;
if ($sourcestyle =~ m/[kpKP]/) {
if (stat($origdir)) {
unless ($sourcestyle =~ m/[KP]/) {
error(_g("orig dir `%s' already exists, not overwriting, ".
'giving up; use -sA, -sK or -sP to override'),
$origdir);
}
push_exit_handler(sub { erasedir($origdir) });
erasedir($origdir);
pop_exit_handler();
} elsif ($! != ENOENT) {
syserr(_g("unable to check for existence of orig dir `%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');
$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{^[^/]+/+}{}; $_ }
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) {
printf { *STDERR } _g('%s: unrepresentable changes to source') . "\n",
$Dpkg::PROGNAME;
exit(1);
}
}
1;