dpkg-source: modify source format "3.0 (git)" to use git bundle

Much better than the old approach of a tarball of the .git repository,
the git bundle format is simple to understand and work with, and
doesn't need to be sanitized for security. Much code went away.

Supports limiting history depth by creating a shallow clone.

Signed-off-by: Raphaël Hertzog <hertzog@debian.org>

1 files changed, 107 insertions, 207 deletions

diff --git a/scripts/Dpkg/Source/Package/V3/git.pm b/scripts/Dpkg/Source/Package/V3/git.pm
index c8e38193c..c7429c11c 100644
--- a/scripts/Dpkg/Source/Package/V3/git.pm
+++ b/scripts/Dpkg/Source/Package/V3/git.pm
@@ -1,7 +1,7 @@
 #
 # git support for dpkg-source
 #
-# Copyright © 2007 Joey Hess <joeyh@debian.org>.
+# 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
@@ -22,20 +22,17 @@ package Dpkg::Source::Package::V3::git;
 use strict;
 use warnings;
 
-our $VERSION = "0.01";
+our $VERSION = "0.02";
 
 use base 'Dpkg::Source::Package';
 
-use Cwd;
+use Cwd qw(abs_path getcwd);
 use File::Basename;
-use File::Find;
 use File::Temp qw(tempdir);
 
 use Dpkg;
 use Dpkg::Gettext;
-use Dpkg::Compression;
 use Dpkg::ErrorHandling;
-use Dpkg::Source::Archive;
 use Dpkg::Exit;
 use Dpkg::Source::Functions qw(erasedir);
 
@@ -55,55 +52,37 @@ sub import {
             return 1;
         }
     }
-    error(_g("This source package can only be manipulated using git, which is not in the PATH."));
+    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);
+        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 (<GIT_CONFIG>) {
-        chomp;
-        my ($key, $value) = split(/\n/, $_, 2);
-        push @{$ret{$key}}, $value;
-    }
-    close(GIT_CONFIG) || syserr(_g("git config exited nonzero"));
-
-    return \%ret;
+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 {
@@ -113,30 +92,16 @@ sub can_build {
 
 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 format `%s'"),
-                 $self->{'fields'}{'Format'});
-    }
-
-    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);
+    chdir($dir) || syserr(_g("unable to chdir to `%s'"), $dir);
 
     # Check for uncommitted files.
     # To support dpkg-source -i, get a list of files
@@ -146,190 +111,125 @@ sub do_build {
     my $core_excludesfile = `git config --get core.excludesfile`;
     chomp $core_excludesfile;
     if (length $core_excludesfile && -e $core_excludesfile) {
-	push @ignores, "--exclude-from=$core_excludesfile";
+        push @ignores, "--exclude-from=$core_excludesfile";
     }
     if (-e ".git/info/exclude") {
-	push @ignores, "--exclude-from=.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");
+         "-z", "--others", @ignores) || subprocerr("git ls-files");
     my @files;
     { local $/ = "\0";
       while (<GIT_LS_FILES>) {
-	  chomp;
-	  if (! length $diff_ignore_regexp ||
-	      ! m/$diff_ignore_regexp/o) {
-	      push @files, $_;
-	  }
+          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));
-    }
+        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) ||
+                syserr(_g("unable to chdir to `%s'"), $old_cwd);
+        $tmp = tempdir("$dirname.git.XXXXXX", DIR => $updir);
+        push @Dpkg::Exit::handlers, 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");
+        chdir($clone_dir) ||
+                syserr(_g("unable to chdir to `%s'"), $clone_dir);
+        $shallowfile = "$basenamerev.gitshallow";
+        system("cp", "-f", "shallow", "$old_cwd/$shallowfile");
+        $? && subprocerr("cp shallow");
+    }
+
+    # 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");
 
-    # 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
+        syserr(_g("unable to chdir to `%s'"), $old_cwd);
 
-    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'};
-    info(_g("building %s in %s"),
-	 $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);
+    if (defined $tmp) {
+        erasedir($tmp);
+        pop @Dpkg::Exit::handlers;
+    }
+
+    $self->add_file($bundlefile);
+    if (defined $shallowfile) {
+        $self->add_file($shallowfile);
+    }
 }
 
-# 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'};
-
-    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 ($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));
+        }
     }
-    my $tarfile = $files[0];
-    if ($tarfile !~ /^\Q$basenamerev\E\.git\.tar\.$compression_re_file_ext$/) {
-	error(_g("expected %s, got %s"),
-	      "$basenamerev.git.tar.$compression_re_file_ext", $tarfile);
+    if (! defined $bundle) {
+        error(_g("format v3.0 (git) expected %s"), "$basenamerev.git");
     }
 
     erasedir($newdirectory);
 
-    # Extract main tarball
-    info(_g("unpacking %s"), $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);
-	}
-    }
+    # Extract git bundle.
+    info(_g("cloning %s"), $bundle);
+    system("git", "clone", "--quiet", $dscdir.$bundle, $newdirectory);
+    $? && subprocerr("git bundle");
 
-    # 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");
+    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"));
+        system("cp", "-f",  $shallow, "$newdirectory/.git/shallow");
+        $? && subprocerr("cp");
     }
 
-    # 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("unable 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);
+    sanity_check($newdirectory);
 }
 
 1;