diff options
| -rw-r--r-- | debian/dpkg-dev.install | 1 | ||||
| -rw-r--r-- | man/dpkg-source.1 | 11 | ||||
| -rw-r--r-- | scripts/Dpkg/Source/VCS/git.pm | 268 | ||||
| -rw-r--r-- | scripts/Makefile.am | 1 | ||||
| -rwxr-xr-x | scripts/dpkg-source.pl | 93 |
5 files changed, 361 insertions, 13 deletions
diff --git a/debian/dpkg-dev.install b/debian/dpkg-dev.install index df13a81e1..a590e887c 100644 --- a/debian/dpkg-dev.install +++ b/debian/dpkg-dev.install @@ -66,3 +66,4 @@ usr/share/man/*/dpkg-shlibdeps.1 usr/share/man/*/*/dpkg-source.1 usr/share/man/*/dpkg-source.1 usr/share/perl5/Dpkg/BuildOptions.pm +usr/share/perl5/Dpkg/Source diff --git a/man/dpkg-source.1 b/man/dpkg-source.1 index 6eae108bd..37da75eae 100644 --- a/man/dpkg-source.1 +++ b/man/dpkg-source.1 @@ -57,6 +57,10 @@ will look for the original source tarfile or the original source directory .IB directory .orig depending on the \fB\-sX\fP arguments. + + +If the source package is being built as a version 3 source package using +a VCS, no upstream tarball or original source directory is needed. .TP .BR \-h ", " \-\-help Show the usage message and exit. @@ -124,7 +128,9 @@ files. Supported values are: .BR \-i [\fIregexp\fP] You may specify a perl regular expression to match files you want filtered out of the list of files for the diff. (This list is -generated by a find command.) \fB\-i\fP by itself enables the option, +generated by a find command.) (If the source package is being built as a +version 3 source package using a VCS, this is instead used to +ignore uncommitted files.) \fB\-i\fP by itself enables the option, with a default that will filter out control files and directories of the most common revision control systems, backup and swap files and Libtool build output directories. There can only be one active regexp, of multiple @@ -176,6 +182,9 @@ will not overwrite existing tarfiles or directories. If this is desired then .BR \-sA ", " \-sP ", " \-sK ", " \-sU " and " \-sR should be used instead. +.PP +If the source package is being built as a version 3 source package using +a VCS, these options do not make sense, and will be ignored. .TP .BR \-sk Specifies to expect the original source as a tarfile, by default diff --git a/scripts/Dpkg/Source/VCS/git.pm b/scripts/Dpkg/Source/VCS/git.pm new file mode 100644 index 000000000..99452fe78 --- /dev/null +++ b/scripts/Dpkg/Source/VCS/git.pm @@ -0,0 +1,268 @@ +#!/usr/bin/perl +# +# git support for dpkg-source +# +# Copyright © 2007 Joey Hess <joeyh@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., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA +package Dpkg::Source::VCS::git; + +use strict; +use warnings; +use Cwd; +use File::Find; +use Dpkg; +use Dpkg::Gettext; + +push (@INC, $dpkglibdir); +require 'controllib.pl'; + +# 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 import { + foreach my $dir (split(/:/, $ENV{PATH})) { + if (-x "$dir/git") { + return 1; + } + } + main::error(sprintf(_g("This source package can only be manipulated using git, which is not in the PATH."))); +} + +sub sanity_check { + my $srcdir=shift; + + if (! -d "$srcdir/.git") { + main::error(sprintf(_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") { + main::error(sprintf(_g("git repository %s uses submodules. This is not yet supported."), $srcdir)); + } + + # Symlinks from .git to outside could cause unpack failures, or + # point to files they shouldn't, so check for and don't allow. + if (-l "$srcdir/.git") { + main::error(sprintf(_g("%s is a symlink"), "$srcdir/.git")); + } + my $abs_srcdir=Cwd::abs_path($srcdir); + find(sub { + if (-l $_) { + if (Cwd::abs_path(readlink($_)) !~ /^\Q$abs_srcdir\E(\/|$)/) { + main::error(sprintf(_g("%s is a symlink to outside %s"), $File::Find::name, $srcdir)); + } + } + }, "$srcdir/.git"); + + return 1; +} + +# Returns a hash of arrays of git config values. +sub read_git_config { + my $file=shift; + + my %ret; + open(GIT_CONFIG, '-|', "git-config", "--file", $file, "--null", "-l") || + main::subprocerr("git-config"); + my ($key, $value); + while (<GIT_CONFIG>) { + if (! defined $key) { + $key=$_; + chomp $key; + $value=""; + } + elsif (/(.*)\0(.*)/) { + $value.=$1; + push @{$ret{$key}}, $value; + $key=$2; + chomp $key; + $value=""; + } + else { + $value.=$1; + } + } + if (defined $key && length $key) { + push @{$ret{$key}}, $value; + } + close(GIT_CONFIG) || main::syserr("git-config exited nonzero"); + + return \%ret; +} + +# Called before a tarball is created, to prepare the tar directory. +sub prep_tar { + my $srcdir=shift; + my $tardir=shift; + + sanity_check($srcdir); + + my $old_cwd=getcwd(); + chdir($srcdir) || + main::syserr(sprintf(_g("unable to chdir to `%s'"), $srcdir)); + + # 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=`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(GIT_LS_FILES, '-|', "git-ls-files", "--modified", "--deleted", + "--others", @ignores) || + main::subprocerr("git-ls-files"); + my @files; + while (<GIT_LS_FILES>) { + chomp; + if (! length $main::diff_ignore_regexp || + ! m/$main::diff_ignore_regexp/o) { + push @files, $_; + } + } + close(GIT_LS_FILES) || main::syserr("git-ls-files exited nonzero"); + if (@files) { + main::error(sprintf(_g("uncommitted, not-ignored changes in working directory: %s"), + join(" ", @files))); + } + + # git-clone isn't used to copy the repo because the it might be an + # unclonable shallow copy. + chdir($old_cwd) || + main::syserr(sprintf(_g("unable to chdir to `%s'"), $old_cwd)); + mkdir($tardir,0755) || + main::syserr(sprintf(_g("unable to create `%s'"), $tardir)); + system("cp", "-a", "$srcdir/.git", $tardir); + $? && main::subprocerr("cp -a $srcdir/.git $tardir"); + chdir($tardir) || + main::syserr(sprintf(_g("unable to chdir to `%s'"), $tardir)); + + # TODO support for creating a shallow clone for those cases where + # uploading the whole repo history is not desired + + # Clean up the new repo to save space. + # First, delete the whole reflog, which is not needed in a + # distributed source package. + system("rm", "-rf", ".git/logs"); + $? && main::subprocerr("rm -rf .git/logs"); + system("git-gc", "--prune"); + $? && main::subprocerr("git-gc --prune"); + + # .git/gitweb is created and used by git-instaweb and should not be + # transferwed by source package. + system("rm", "-rf", ".git/gitweb"); + $? && main::subprocerr("rm -rf .git/gitweb"); + + # As an optimisation, remove the index. It will be recreated by git + # reset during unpack. It's probably small, but you never know, this + # might save a lot of space. (Also, the index file may not be + # portable.) + unlink(".git/index"); # error intentionally ignored + + chdir($old_cwd) || + main::syserr(sprintf(_g("unable to chdir to `%s'"), $old_cwd)); + + return 1; +} + +# Called after a tarball is unpacked, to check out the working copy. +sub post_unpack_tar { + my $srcdir=shift; + + sanity_check($srcdir); + + my $old_cwd=getcwd(); + chdir($srcdir) || + main::syserr(sprintf(_g("unable to chdir to `%s'"), $srcdir)); + + # Disable git hooks, as unpacking a source package should not + # involve running code. + foreach my $hook (glob("./.git/hooks/*")) { + if (-x $hook) { + main::warning(sprintf(_g("executable bit set on %s; clearing"), $hook)); + chmod(0666 &~ umask(), $hook) || + main::syserr(sprintf(_g("unable to change permission of `%s'"), $hook)); + } + } + + # This is a paranoia measure, since the index is not normally + # provided by possibly-untrusted third parties, remove it if + # present (git will recreate it as needed). + if (-e ".git/index" || -l ".git/index") { + unlink(".git/index") || + main::syserr(sprintf(_g("unable to remove `%s'"), ".git/index")); + } + + # Comment out potentially probamatic or annoying stuff in + # .git/config. + my $safe_fields=qr/^( + core\.autocrlf | + branch\..* | + remote\..* | + core\.repositoryformatversion | + core\.filemode | + core\.logallrefupdates | + core\.bare + )$/x; + my %config=%{read_git_config(".git/config")}; + foreach my $field (keys %config) { + if ($field =~ /$safe_fields/) { + delete $config{$field}; + } + else { + system("git-config", "--file", ".git/config", + "--unset-all", $field); + $? && main::subprocerr("git-config --file .git/config --unset-all $field"); + } + } + if (%config) { + main::warning(_g("modifying .git/config to comment out some settings")); + open(GIT_CONFIG, ">>", ".git/config") || + main::syserr(sprintf(_g("unstable to append to %s", ".git/config"))); + print GIT_CONFIG "\n# "._g("The following setting(s) were disabled by dpkg-source").":\n"; + foreach my $field (sort keys %config) { + foreach my $value (@{$config{$field}}) { + print GIT_CONFIG "# $field=$value\n"; + } + } + close GIT_CONFIG; + } + + # .git/gitweb is created and used by git-instaweb and should not be + # transferwed by source package. + system("rm", "-rf", ".git/gitweb"); + $? && main::subprocerr("rm -rf .git/gitweb"); + + # git-checkout is used to repopulate the WC with files + # and recreate the index. + system("git-checkout", "-f"); + $? && main::subprocerr("git-checkout -f"); + + chdir($old_cwd) || + main::syserr(sprintf(_g("unable to chdir to `%s'"), $old_cwd)); + + return 1; +} + +1 diff --git a/scripts/Makefile.am b/scripts/Makefile.am index d3793f6f7..13ff06c3f 100644 --- a/scripts/Makefile.am +++ b/scripts/Makefile.am @@ -80,6 +80,7 @@ nobase_dist_perllib_DATA = \ Dpkg/Gettext.pm \ Dpkg/Path.pm \ Dpkg/Version.pm \ + Dpkg/Source/VCS/git.pm \ Dpkg.pm dist_pkglib_SCRIPTS = \ diff --git a/scripts/dpkg-source.pl b/scripts/dpkg-source.pl index afbd609ac..ad7085359 100755 --- a/scripts/dpkg-source.pl +++ b/scripts/dpkg-source.pl @@ -17,7 +17,7 @@ my $controlfile; my $changelogfile; my $changelogformat; -my $diff_ignore_regexp = ''; +our $diff_ignore_regexp = ''; my $diff_ignore_default_regexp = ' # Ignore general backup files (?:^|/).*~$| @@ -71,7 +71,7 @@ $diff_ignore_default_regexp =~ s/\n//sg; my $sourcestyle = 'X'; my $min_dscformat = 1; -my $max_dscformat = 2; +my $max_dscformat = 3; my $def_dscformat = "1.0"; # default format for -b my $expectprefix; @@ -205,6 +205,13 @@ sub handleformat { return $1 >= $min_dscformat && $1 <= $max_dscformat; } +sub loadvcs { + my $vcs = shift; + my $mod = "Dpkg::Source::VCS::$vcs"; + eval qq{require $mod}; + return $@ || import $mod; +} + my $opmode; my $tar_ignore_default_pattern_done; @@ -276,10 +283,6 @@ $SIG{'PIPE'} = 'DEFAULT'; if ($opmode eq 'build') { - $sourcestyle =~ y/X/A/; - $sourcestyle =~ m/[akpursnAKPUR]/ || - &usageerr(sprintf(_g("source handling style -s%s not allowed with -b"), $sourcestyle)); - @ARGV || &usageerr(_g("-b needs a directory")); @ARGV<=2 || &usageerr(_g("-b takes at most a directory and an orig source argument")); my $dir = shift(@ARGV); @@ -307,7 +310,7 @@ if ($opmode eq 'build') { if (s/^C //) { if (m/^Source$/i) { setsourcepackage($v); - } elsif (m/^(Standards-Version|Origin|Maintainer|Homepage)$/i || + } elsif (m/^(Format|Standards-Version|Origin|Maintainer|Homepage)$/i || m/^Vcs-(Browser|Arch|Bzr|Cvs|Darcs|Git|Hg|Mtn|Svn)$/i) { $f{$_}= $v; } @@ -375,6 +378,39 @@ if ($opmode eq 'build') { &internerr(sprintf(_g("value from nowhere, with key >%s< and value >%s<"), $_, $v)); } } + + my $vcs; + if ($f{Format} =~ /^\s*(\d+\.\d+)\s*$/) { + if ($1 >= 3.0) { + error(sprintf(_g("don't know how to generate %s format source package (missing vcs specifier in Format field?)"), $1)); + } + if ($1 > 1.0) { + error(sprintf(_g("don't know how to generate %s format source package"), $1)); + } + } + elsif ($f{Format} =~ /^\s*(\d+(?:\.\d+)?)\s+\((\w+)\)\s*$/) { + $f{Format}=$1; + if ($1 < 3.0) { + error(sprintf(_g("control info file 'Format' field for version %s does not support vcs specifier \"%s\""), $1, $2)); + } + if ($1 >= 4) { + error(sprintf(_g("unsupported control info file 'Format' value \"%s\""), $1)); + } + + $vcs=$2; + loadvcs($2) + || error(sprintf(_g("unsupported vcs \"%s\" in control info file 'Format' field"), $2)); + + if ($sourcestyle =~ /[akpursKPUR]/) { + warning(sprintf(_g("source handling style -s%s not supported when generating %s format source package"), $sourcestyle, $vcs)); + } + $sourcestyle='v'; + } + + $sourcestyle =~ y/X/A/; + $sourcestyle =~ m/[akpursnAKPURv]/ || + &usageerr(sprintf(_g("source handling style -s%s not allowed with -b"), $sourcestyle)); + $f{'Binary'}= join(', ',@binarypackages); for my $f (keys %override) { @@ -468,7 +504,17 @@ if ($opmode eq 'build') { my $tardirbase; my $origdirname; - if ($sourcestyle ne 'n') { + if ($sourcestyle eq 'v') { + $tarname="$basenamerev.$vcs.tar.gz"; + $tardirbase= $dirbase; $tardirname= "$dirbase/$tarname.tmp"; + + eval qq{Dpkg::Source::VCS::${vcs}::prep_tar(\$dir, \$tardirname)}; + if ($@) { + &syserr($@); + } + push @exit_handlers, sub { erasedir($tardirname) }; + } + elsif ($sourcestyle ne 'n') { my $origdirbase = $origdir; $origdirbase =~ s,/?$,,; $origdirbase =~ s,[^/]+$,,; $origdirname= $&; @@ -489,10 +535,10 @@ if ($opmode eq 'build') { $tarname= "$basenamerev.tar.$comp_ext"; } - if ($sourcestyle =~ m/[nurUR]/) { + if ($sourcestyle =~ m/[nurURv]/) { if (stat($tarname)) { - $sourcestyle =~ m/[nUR]/ || + $sourcestyle =~ m/[nURv]/ || &error(sprintf(_g("tarfile `%s' already exists, not overwriting,". " giving up; use -sU or -sR to override"), $tarname)); } elsif ($! != ENOENT) { @@ -561,6 +607,10 @@ if ($opmode eq 'build') { &syserr(sprintf(_g("unable to remove `%s'"), "$origtargz.tmp-nest")); pop @exit_handlers; } + + if ($sourcestyle eq 'v') { + erasedir($tardirname) + } if ($sourcestyle =~ m/[kpursKPUR]/) { @@ -823,6 +873,7 @@ if ($opmode eq 'build') { my @tarfiles; my $difffile; my $debianfile; + my %vcsfiles; my %seen; for my $file (split(/\n /, $files)) { next if $file eq ''; @@ -846,6 +897,11 @@ if ($opmode eq 'build') { else { unshift @tarfiles, $file; } } elsif (/^\.debian\.tar$/) { $debianfile = $file; + } elsif (/^\.(\w+)\.tar$/) { + my $vcs=$1; + # TODO try to load vcs module + push @tarfiles, $file; + $vcsfiles{$file}=$vcs; } elsif (/^\.diff$/) { $difffile = $file; } else { @@ -858,14 +914,17 @@ if ($opmode eq 'build') { if ($native) { warning(_g("multiple tarfiles in native package")) if @tarfiles > 1; warning(_g("native package with .orig.tar")) - unless $seen{'.tar'} or $seen{"-$revision.tar"}; + unless $seen{'.tar'} or $seen{"-$revision.tar"} or %vcsfiles; } else { - warning(_g("no upstream tarfile in Files field")) unless $seen{'.orig.tar'}; + warning(_g("no upstream tarfile in Files field")) unless $seen{'.orig.tar'} or %vcsfiles; if ($dscformat =~ /^1\./) { warning(sprintf(_g("multiple upstream tarballs in %s format dsc"), $dscformat)) if @tarfiles > 1; warning(sprintf(_g("debian.tar in %s format dsc"), $dscformat)) if $debianfile; } } + if (%vcsfiles && $dscformat !~ /^3\./) { + warning(sprintf(_g("<rc>.tar file in %s format dsc"), $dscformat)); + } $newdirectory = $sourcepackage.'-'.$baseversion unless defined($newdirectory); $expectprefix = $newdirectory; @@ -941,6 +1000,16 @@ if ($opmode eq 'build') { $? && subprocerr("cp $expectprefix to $newdirectory.tmp-keep"); } } + + if (exists $vcsfiles{$tarfile}) { + printf(_g("%s: extracting source from %s repository")."\n", $progname, $vcsfiles{$tarfile}); + loadvcs($vcsfiles{$tarfile}) + || error(sprintf(_g("unsupported vcs \"%s\""), $vcsfiles{$tarfile})); + eval qq{Dpkg::Source::VCS::$vcsfiles{$tarfile}::post_unpack_tar(\$target)}; + if ($@) { + &syserr($@); + } + } } my @patches; |