|
|
@@ -0,0 +1,373 @@
|
|
|
+# 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, write to the Free Software Foundation, Inc.,
|
|
|
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
|
|
|
+
|
|
|
+package Dpkg::Source::Package::V1_0;
|
|
|
+
|
|
|
+use strict;
|
|
|
+use warnings;
|
|
|
+
|
|
|
+use base 'Dpkg::Source::Package';
|
|
|
+
|
|
|
+use Dpkg;
|
|
|
+use Dpkg::Gettext;
|
|
|
+use Dpkg::ErrorHandling qw(error syserr warning usageerr subprocerr);
|
|
|
+use Dpkg::Compression;
|
|
|
+use Dpkg::Source::Archive;
|
|
|
+use Dpkg::Source::Patch;
|
|
|
+use Dpkg::Version qw(check_version parseversion);
|
|
|
+use Dpkg::Exit;
|
|
|
+use Dpkg::Source::Functions qw(erasedir);
|
|
|
+
|
|
|
+use POSIX;
|
|
|
+use File::Basename;
|
|
|
+use File::Temp qw(tempfile);
|
|
|
+
|
|
|
+sub extract {
|
|
|
+ my ($self, $newdirectory) = @_;
|
|
|
+ my $sourcestyle = $self->{'options'}{'sourcestyle'};
|
|
|
+ my $fields = $self->{'fields'};
|
|
|
+
|
|
|
+ $sourcestyle =~ y/X/p/;
|
|
|
+ $sourcestyle =~ m/[pun]/ ||
|
|
|
+ usageerr(_g("source handling style -s%s not allowed with -x"),
|
|
|
+ $sourcestyle);
|
|
|
+
|
|
|
+ my $dsc = $self->get_filename();
|
|
|
+ my $dscdir = $self->{'basedir'};
|
|
|
+
|
|
|
+ my $sourcepackage = $fields->{'Source'};
|
|
|
+
|
|
|
+ check_version($fields->{'Version'});
|
|
|
+
|
|
|
+ my %v = parseversion($fields->{'Version'});
|
|
|
+ my $baseversion = $v{'version'};
|
|
|
+ my $revision = ($version =~ m/-/) ? $v{'revision'} : '';
|
|
|
+ my $version = $baseversion . ($revision ? "-$revision" : "");
|
|
|
+ my $basename = $self->get_basename();
|
|
|
+ my $basenamerev = $self->get_basename(1);
|
|
|
+
|
|
|
+ # V1.0 only supports gzip compression
|
|
|
+ my ($tarfile, $difffile);
|
|
|
+ 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$basenamerev\E\.diff\.gz$/) {
|
|
|
+ $difffile = $file;
|
|
|
+ } else {
|
|
|
+ error(_g("unrecognized file for a v1.0 source package: %s"), $file);
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ error(_g("no tarfile in Files field")) unless $tarfile;
|
|
|
+ my $native = $difffile ? 0 : 1;
|
|
|
+ if ($native) {
|
|
|
+ warning(_g("native package with .orig.tar"))
|
|
|
+ if $tarfile =~ /\.orig\.tar\.gz$/;
|
|
|
+ } else {
|
|
|
+ warning(_g("no upstream tarfile in Files field"))
|
|
|
+ unless defined $tarfile;
|
|
|
+ }
|
|
|
+
|
|
|
+ $newdirectory = $sourcepackage.'-'.$baseversion unless defined($newdirectory);
|
|
|
+ my $expectprefix = $newdirectory;
|
|
|
+ $expectprefix .= '.orig' if $difffile;
|
|
|
+
|
|
|
+ erasedir($newdirectory);
|
|
|
+ if (-e "$expectprefix") {
|
|
|
+ rename("$expectprefix","$newdirectory.tmp-keep") ||
|
|
|
+ syserr(_g("unable to rename `%s' to `%s'"), $expectprefix,
|
|
|
+ "$newdirectory.tmp-keep");
|
|
|
+ }
|
|
|
+
|
|
|
+ printf(_g("%s: unpacking %s")."\n", $progname, $tarfile);
|
|
|
+ my $tar = Dpkg::Source::Archive->new(filename => "$dscdir$tarfile");
|
|
|
+ $tar->extract($expectprefix);
|
|
|
+
|
|
|
+ # for the first tar file:
|
|
|
+ if ($tarfile and not $native)
|
|
|
+ {
|
|
|
+ # -sp: copy the .orig.tar.gz if required
|
|
|
+ if ($sourcestyle =~ /p/) {
|
|
|
+ stat("$dscdir$tarfile") ||
|
|
|
+ syserr(_g("failed to stat `%s' to see if need to copy"),
|
|
|
+ "$dscdir$tarfile");
|
|
|
+
|
|
|
+ my ($dsctardev, $dsctarino) = stat _;
|
|
|
+ my $copy_required;
|
|
|
+
|
|
|
+ if (stat($tarfile)) {
|
|
|
+ my ($dumptardev, $dumptarino) = stat _;
|
|
|
+ $copy_required = ($dumptardev != $dsctardev ||
|
|
|
+ $dumptarino != $dsctarino);
|
|
|
+ } else {
|
|
|
+ unless ($! == ENOENT) {
|
|
|
+ syserr(_g("failed to check destination `%s' " .
|
|
|
+ "to see if need to copy"), $tarfile);
|
|
|
+ }
|
|
|
+ $copy_required = 1;
|
|
|
+ }
|
|
|
+
|
|
|
+ if ($copy_required) {
|
|
|
+ system('cp','--',"$dscdir$tarfile", $tarfile);
|
|
|
+ subprocerr("cp $dscdir$tarfile to $tarfile") if $?;
|
|
|
+ }
|
|
|
+ }
|
|
|
+ # -su: keep .orig directory unpacked
|
|
|
+ elsif ($sourcestyle =~ /u/ and $expectprefix ne $newdirectory) {
|
|
|
+ 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 $?;
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ if ($newdirectory ne $expectprefix)
|
|
|
+ {
|
|
|
+ rename($expectprefix,$newdirectory) ||
|
|
|
+ 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) ||
|
|
|
+ syserr(_g("failed to rename saved %s to %s"),
|
|
|
+ "$newdirectory.tmp-keep", $expectprefix);
|
|
|
+ }
|
|
|
+ }
|
|
|
+
|
|
|
+ if ($difffile) {
|
|
|
+ my $patch = "$dscdir$difffile";
|
|
|
+ printf(_g("%s: applying %s")."\n", $progname, $patch);
|
|
|
+ my $patch_obj = Dpkg::Source::Patch->new(filename => $patch);
|
|
|
+ $patch_obj->apply($newdirectory, force_timestamp => 1,
|
|
|
+ timestamp => time());
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+sub 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_regexp = $self->{'options'}{'diff_ignore_regexp'};
|
|
|
+
|
|
|
+ $dir =~ s{/+$}{}; # Strip trailing /
|
|
|
+
|
|
|
+ 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) ||
|
|
|
+ syserr(_g("cannot stat orig argument %s"), $origarg);
|
|
|
+ if (-d _) {
|
|
|
+ $origdir = $origarg;
|
|
|
+ $origdir =~ s{/*$}{};
|
|
|
+
|
|
|
+ $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("orig argument $origarg is not a plain file or directory");
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ $sourcestyle =~ y/aA/nn/;
|
|
|
+ $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, $origdirname);
|
|
|
+ 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");
|
|
|
+ }
|
|
|
+ } else {
|
|
|
+ $tardirbase = $dirbase;
|
|
|
+ $tardirname = $dirname;
|
|
|
+ $tarname = "$basenamerev.tar.gz";
|
|
|
+ }
|
|
|
+
|
|
|
+ if ($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);
|
|
|
+ }
|
|
|
+
|
|
|
+ printf(_g("%s: building %s in %s")."\n",
|
|
|
+ $progname, $sourcepackage, $tarname);
|
|
|
+
|
|
|
+ my ($ntfh, $newtar) = tempfile("$tarname.new.XXXXXX",
|
|
|
+ DIR => getcwd(), UNLINK => 0);
|
|
|
+ my $tar = Dpkg::Source::Archive->new(filename => $newtar,
|
|
|
+ compression => get_compression_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) ||
|
|
|
+ syserr(_g("unable to rename `%s' (newly created) to `%s'"),
|
|
|
+ $newtar, $tarname);
|
|
|
+ chmod(0666 &~ umask(), $tarname) ||
|
|
|
+ syserr(_g("unable to change permission of `%s'"), $tarname);
|
|
|
+ } else {
|
|
|
+ printf(_g("%s: building %s using existing %s")."\n",
|
|
|
+ $progname, $sourcepackage, $tarname);
|
|
|
+ }
|
|
|
+
|
|
|
+ $self->add_file($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 @Dpkg::Exit::handlers, sub { erasedir($origdir) };
|
|
|
+ erasedir($origdir);
|
|
|
+ pop @Dpkg::Exit::handlers;
|
|
|
+ } 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";
|
|
|
+ printf(_g("%s: building %s in %s")."\n",
|
|
|
+ $progname, $sourcepackage, $diffname);
|
|
|
+ my ($ndfh, $newdiffgz) = tempfile("$diffname.new.XXXXXX",
|
|
|
+ DIR => getcwd(), UNLINK => 0);
|
|
|
+ my $diff = Dpkg::Source::Patch->new(filename => $newdiffgz,
|
|
|
+ compression => get_compression_from_filename($diffname));
|
|
|
+ $diff->create();
|
|
|
+ $diff->add_diff_directory($origdir, $dir,
|
|
|
+ basedirname => $basedirname,
|
|
|
+ diff_ignore_regexp => $diff_ignore_regexp);
|
|
|
+ $diff->finish() || $ur++;
|
|
|
+
|
|
|
+ rename($newdiffgz, $diffname) ||
|
|
|
+ syserr(_g("unable to rename `%s' (newly created) to `%s'"),
|
|
|
+ $newdiffgz, $diffname);
|
|
|
+ chmod(0666 &~ umask(), $diffname) ||
|
|
|
+ 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",
|
|
|
+ $progname);
|
|
|
+ exit(1);
|
|
|
+ }
|
|
|
+}
|
|
|
+
|
|
|
+# vim: set et sw=4 ts=8
|
|
|
+1;
|