From: Frank Lichtenheld Date: Fri, 29 Feb 2008 22:09:43 +0000 (+0100) Subject: Add support for v3.0 (git) package X-Git-Url: https://err.no/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=b7c2e1b54e449b11bc534745a031245dea6f1ee3;p=dpkg Add support for v3.0 (git) package * scripts/Dpkg/Source/VCS/git.pm: Move this to... * scripts/Dpkg/Source/Package/V3_0/git.pm: ...here, and port to new API. --- diff --git a/scripts/Dpkg/Source/Package/V3_0/git.pm b/scripts/Dpkg/Source/Package/V3_0/git.pm new file mode 100644 index 00000000..37dce26b --- /dev/null +++ b/scripts/Dpkg/Source/Package/V3_0/git.pm @@ -0,0 +1,329 @@ +#!/usr/bin/perl +# +# git support for dpkg-source +# +# Copyright © 2007 Joey Hess . +# Copyright © 2008 Frank Lichtenheld +# +# 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::Package::V3_0::git; + +use strict; +use warnings; + +use base 'Dpkg::Source::Package'; + +use Cwd; +use File::Basename; +use File::Find; +use File::Temp qw(tempdir); + +use Dpkg; +use Dpkg::Gettext; +use Dpkg::Compression; +use Dpkg::ErrorHandling qw(error warning subprocerr syserr); +use Dpkg::Version qw(check_version); +use Dpkg::Source::Archive; +use Dpkg::Exit; +use Dpkg::Source::Functions qw(erasedir); + +# 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; + } + } + error(_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") { + 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); + } + + # 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") { + error(_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(\/|$)/) { + error(_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") || + subprocerr("git config"); + local $/ = "\0"; + while () { + chomp; + my ($key, $value) = split(/\n/, $_, 2); + push @{$ret{$key}}, $value; + } + close(GIT_CONFIG) || syserr(_g("git config exited nonzero")); + + return \%ret; +} + +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_regexp = $self->{'options'}{'diff_ignore_regexp'}; + + $dir =~ s{/+$}{}; # Strip trailing / + my ($dirname, $updir) = fileparse($dir); + + if (scalar(@argv)) { + usageerr(_g("-b takes only one parameter with v3.0 source packages")); + } + + my $sourcepackage = $self->{'fields'}{'Source'}; + my $basenamerev = $self->get_basename(1); + my $basename = $self->get_basename(); + my $basedirname = $basename; + $basedirname =~ s/_/-/; + + sanity_check($dir); + + my $old_cwd=getcwd(); + chdir($dir) || + 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=`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", + "-z", "--others", @ignores) || + subprocerr("git ls-files"); + my @files; + { local $/ = "\0"; + while () { + chomp; + if (! length $diff_ignore_regexp || + ! m/$diff_ignore_regexp/o) { + push @files, $_; + } + } + } + close(GIT_LS_FILES) || syserr(_g("git ls-files exited nonzero")); + if (@files) { + error(_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) || + syserr(_g("unable to chdir to `%s'"), $old_cwd); + + my $tmp = tempdir("$dirname.git.XXXXXX", DIR => $updir); + push @Dpkg::Exit::handlers, sub { erasedir($tmp) }; + my $tardir = "$tmp/$dirname"; + mkdir($tardir) || + syserr(_g("cannot create directory %s"), $tardir); + + system("cp", "-a", "$dir/.git", $tardir); + $? && subprocerr("cp -a $dir/.git $tardir"); + chdir($tardir) || + syserr(_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"); + $? && subprocerr("rm -rf .git/logs"); + system("git", "gc", "--prune"); + $? && 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"); + $? && 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) || + syserr(_g("unable to chdir to `%s'"), $old_cwd); + + # Create the tar file + my $debianfile = "$basenamerev.git.tar." . $self->{'options'}{'comp_ext'}; + printf(_g("%s: building %s in %s")."\n", + $progname, $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 @Dpkg::Exit::handlers; + + $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 $dscdir = $self->{'basedir'}; + + check_version($fields->{'Version'}); + + my $basename = $self->get_basename(); + my $basenamerev = $self->get_basename(1); + + my @files = $self->get_files(); + if (@files > 1) { + error(_g("format v3.0 uses only one source file")); + } + my $tarfile = $files[0]; + if ($tarfile !~ /^\Q$basenamerev\E\.git\.tar\.$comp_regex$/) { + error(_g("expected %s, got %s"), + "$basenamerev.git.tar.$comp_regex", $tarfile); + } + + erasedir($newdirectory); + + # Extract main tarball + printf(_g("%s: unpacking %s")."\n", $progname, $tarfile); + my $tar = Dpkg::Source::Archive->new(filename => "$dscdir$tarfile"); + $tar->extract($newdirectory); + + sanity_check($newdirectory); + + my $old_cwd=getcwd(); + chdir($newdirectory) || + syserr(_g("unable to chdir to `%s'"), $newdirectory); + + # Disable git hooks, as unpacking a source package should not + # involve running code. + foreach my $hook (glob("./.git/hooks/*")) { + if (-x $hook) { + warning(_g("executable bit set on %s; clearing"), $hook); + chmod(0666 &~ umask(), $hook) || + syserr(_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") || + syserr(_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); + $? && subprocerr("git config --file .git/config --unset-all $field"); + } + } + if (%config) { + warning(_g("modifying .git/config to comment out some settings")); + open(GIT_CONFIG, ">>", ".git/config") || + syserr(_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}}) { + if (defined($value)) { + print GIT_CONFIG "# $field=$value\n"; + } else { + print GIT_CONFIG "# $field\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"); + $? && subprocerr("rm -rf .git/gitweb"); + + # git checkout is used to repopulate the WC with files + # and recreate the index. + system("git", "checkout", "-f"); + $? && subprocerr("git checkout -f"); + + chdir($old_cwd) || + syserr(_g("unable to chdir to `%s'"), $old_cwd); +} + +1 diff --git a/scripts/Dpkg/Source/VCS/git.pm b/scripts/Dpkg/Source/VCS/git.pm deleted file mode 100644 index c7703889..00000000 --- a/scripts/Dpkg/Source/VCS/git.pm +++ /dev/null @@ -1,260 +0,0 @@ -#!/usr/bin/perl -# -# git support for dpkg-source -# -# Copyright © 2007 Joey Hess . -# -# 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; -use Dpkg::ErrorHandling qw(error warning subprocerr syserr); - -# 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; - } - } - error(_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") { - 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); - } - - # 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") { - error(_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(\/|$)/) { - error(_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") || - subprocerr("git config"); - local $/ = "\0"; - while () { - chomp; - my ($key, $value) = split(/\n/, $_, 2); - push @{$ret{$key}}, $value; - } - close(GIT_CONFIG) || syserr(_g("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) || - syserr(_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", - "-z", "--others", @ignores) || - subprocerr("git ls-files"); - my @files; - { local $/ = "\0"; - while () { - chomp; - if (! length $main::diff_ignore_regexp || - ! m/$main::diff_ignore_regexp/o) { - push @files, $_; - } - } - } - close(GIT_LS_FILES) || syserr(_g("git ls-files exited nonzero")); - if (@files) { - error(_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) || - syserr(_g("unable to chdir to `%s'"), $old_cwd); - mkdir($tardir,0755) || - syserr(_g("unable to create `%s'"), $tardir); - system("cp", "-a", "$srcdir/.git", $tardir); - $? && subprocerr("cp -a $srcdir/.git $tardir"); - chdir($tardir) || - syserr(_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"); - $? && subprocerr("rm -rf .git/logs"); - system("git", "gc", "--prune"); - $? && 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"); - $? && 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) || - syserr(_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) || - syserr(_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) { - warning(_g("executable bit set on %s; clearing"), $hook); - chmod(0666 &~ umask(), $hook) || - syserr(_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") || - syserr(_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); - $? && subprocerr("git config --file .git/config --unset-all $field"); - } - } - if (%config) { - warning(_g("modifying .git/config to comment out some settings")); - open(GIT_CONFIG, ">>", ".git/config") || - syserr(_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}}) { - if (defined($value)) { - print GIT_CONFIG "# $field=$value\n"; - } else { - print GIT_CONFIG "# $field\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"); - $? && subprocerr("rm -rf .git/gitweb"); - - # git checkout is used to repopulate the WC with files - # and recreate the index. - system("git", "checkout", "-f"); - $? && subprocerr("git checkout -f"); - - chdir($old_cwd) || - syserr(_g("unable to chdir to `%s'"), $old_cwd); - - return 1; -} - -1