diff options
Diffstat (limited to 'scripts/Dpkg/Source/Package/V3/Git.pm')
-rw-r--r-- | scripts/Dpkg/Source/Package/V3/Git.pm | 283 |
1 files changed, 283 insertions, 0 deletions
diff --git a/scripts/Dpkg/Source/Package/V3/Git.pm b/scripts/Dpkg/Source/Package/V3/Git.pm new file mode 100644 index 0000000..721036a --- /dev/null +++ b/scripts/Dpkg/Source/Package/V3/Git.pm @@ -0,0 +1,283 @@ +# +# git support for dpkg-source +# +# 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/>. + +package Dpkg::Source::Package::V3::Git; + +use strict; +use warnings; + +our $VERSION = '0.02'; + +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 $?; + } +} + +1; |