OLD | NEW |
(Empty) | |
| 1 # |
| 2 # git support for dpkg-source |
| 3 # |
| 4 # Copyright © 2007,2010 Joey Hess <joeyh@debian.org>. |
| 5 # Copyright © 2008 Frank Lichtenheld <djpig@debian.org> |
| 6 # |
| 7 # This program is free software; you can redistribute it and/or modify |
| 8 # it under the terms of the GNU General Public License as published by |
| 9 # the Free Software Foundation; either version 2 of the License, or |
| 10 # (at your option) any later version. |
| 11 # |
| 12 # This program is distributed in the hope that it will be useful, |
| 13 # but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 15 # GNU General Public License for more details. |
| 16 # |
| 17 # You should have received a copy of the GNU General Public License |
| 18 # along with this program. If not, see <https://www.gnu.org/licenses/>. |
| 19 |
| 20 package Dpkg::Source::Package::V3::Git; |
| 21 |
| 22 use strict; |
| 23 use warnings; |
| 24 |
| 25 our $VERSION = '0.02'; |
| 26 |
| 27 use parent qw(Dpkg::Source::Package); |
| 28 |
| 29 use Cwd qw(abs_path getcwd); |
| 30 use File::Basename; |
| 31 use File::Temp qw(tempdir); |
| 32 |
| 33 use Dpkg; |
| 34 use Dpkg::Gettext; |
| 35 use Dpkg::ErrorHandling; |
| 36 use Dpkg::Exit qw(push_exit_handler pop_exit_handler); |
| 37 use Dpkg::Source::Functions qw(erasedir); |
| 38 |
| 39 our $CURRENT_MINOR_VERSION = '0'; |
| 40 |
| 41 # Remove variables from the environment that might cause git to do |
| 42 # something unexpected. |
| 43 delete $ENV{GIT_DIR}; |
| 44 delete $ENV{GIT_INDEX_FILE}; |
| 45 delete $ENV{GIT_OBJECT_DIRECTORY}; |
| 46 delete $ENV{GIT_ALTERNATE_OBJECT_DIRECTORIES}; |
| 47 delete $ENV{GIT_WORK_TREE}; |
| 48 |
| 49 sub import { |
| 50 foreach my $dir (split(/:/, $ENV{PATH})) { |
| 51 if (-x "$dir/git") { |
| 52 return 1; |
| 53 } |
| 54 } |
| 55 error(_g('cannot unpack git-format source package because ' . |
| 56 'git is not in the PATH')); |
| 57 } |
| 58 |
| 59 sub sanity_check { |
| 60 my $srcdir = shift; |
| 61 |
| 62 if (! -d "$srcdir/.git") { |
| 63 error(_g('source directory is not the top directory of a git ' . |
| 64 'repository (%s/.git not present), but Format git was ' . |
| 65 'specified'), $srcdir); |
| 66 } |
| 67 if (-s "$srcdir/.gitmodules") { |
| 68 error(_g('git repository %s uses submodules; this is not yet supported')
, |
| 69 $srcdir); |
| 70 } |
| 71 |
| 72 return 1; |
| 73 } |
| 74 |
| 75 sub parse_cmdline_option { |
| 76 my ($self, $opt) = @_; |
| 77 return 1 if $self->SUPER::parse_cmdline_option($opt); |
| 78 if ($opt =~ /^--git-ref=(.*)$/) { |
| 79 push @{$self->{options}{git_ref}}, $1; |
| 80 return 1; |
| 81 } elsif ($opt =~ /^--git-depth=(\d+)$/) { |
| 82 $self->{options}{git_depth} = $1; |
| 83 return 1; |
| 84 } |
| 85 return 0; |
| 86 } |
| 87 |
| 88 sub can_build { |
| 89 my ($self, $dir) = @_; |
| 90 |
| 91 return (0, _g("doesn't contain a git repository")) unless -d "$dir/.git"; |
| 92 return 1; |
| 93 } |
| 94 |
| 95 sub do_build { |
| 96 my ($self, $dir) = @_; |
| 97 my $diff_ignore_regex = $self->{options}{diff_ignore_regex}; |
| 98 |
| 99 $dir =~ s{/+$}{}; # Strip trailing / |
| 100 my ($dirname, $updir) = fileparse($dir); |
| 101 my $basenamerev = $self->get_basename(1); |
| 102 |
| 103 sanity_check($dir); |
| 104 |
| 105 my $old_cwd = getcwd(); |
| 106 chdir($dir) or syserr(_g("unable to chdir to `%s'"), $dir); |
| 107 |
| 108 # Check for uncommitted files. |
| 109 # To support dpkg-source -i, get a list of files |
| 110 # equivalent to the ones git status finds, and remove any |
| 111 # ignored files from it. |
| 112 my @ignores = '--exclude-per-directory=.gitignore'; |
| 113 my $core_excludesfile = `git config --get core.excludesfile`; |
| 114 chomp $core_excludesfile; |
| 115 if (length $core_excludesfile && -e $core_excludesfile) { |
| 116 push @ignores, "--exclude-from=$core_excludesfile"; |
| 117 } |
| 118 if (-e '.git/info/exclude') { |
| 119 push @ignores, '--exclude-from=.git/info/exclude'; |
| 120 } |
| 121 open(my $git_ls_files_fh, '-|', 'git', 'ls-files', '--modified', '--deleted'
, |
| 122 '-z', '--others', @ignores) or subprocerr('git ls-files'); |
| 123 my @files; |
| 124 { local $/ = "\0"; |
| 125 while (<$git_ls_files_fh>) { |
| 126 chomp; |
| 127 if (! length $diff_ignore_regex || |
| 128 ! m/$diff_ignore_regex/o) { |
| 129 push @files, $_; |
| 130 } |
| 131 } |
| 132 } |
| 133 close($git_ls_files_fh) or syserr(_g('git ls-files exited nonzero')); |
| 134 if (@files) { |
| 135 error(_g('uncommitted, not-ignored changes in working directory: %s'), |
| 136 join(' ', @files)); |
| 137 } |
| 138 |
| 139 # If a depth was specified, need to create a shallow clone and |
| 140 # bundle that. |
| 141 my $tmp; |
| 142 my $shallowfile; |
| 143 if ($self->{options}{git_depth}) { |
| 144 chdir($old_cwd) or syserr(_g("unable to chdir to `%s'"), $old_cwd); |
| 145 $tmp = tempdir("$dirname.git.XXXXXX", DIR => $updir); |
| 146 push_exit_handler(sub { erasedir($tmp) }); |
| 147 my $clone_dir = "$tmp/repo.git"; |
| 148 # file:// is needed to avoid local cloning, which does not |
| 149 # create a shallow clone. |
| 150 info(_g('creating shallow clone with depth %s'), |
| 151 $self->{options}{git_depth}); |
| 152 system('git', 'clone', '--depth=' . $self->{options}{git_depth}, |
| 153 '--quiet', '--bare', 'file://' . abs_path($dir), $clone_dir); |
| 154 subprocerr('git clone') if $?; |
| 155 chdir($clone_dir) |
| 156 or syserr(_g("unable to chdir to `%s'"), $clone_dir); |
| 157 $shallowfile = "$basenamerev.gitshallow"; |
| 158 system('cp', '-f', 'shallow', "$old_cwd/$shallowfile"); |
| 159 subprocerr('cp shallow') if $?; |
| 160 } |
| 161 |
| 162 # Create the git bundle. |
| 163 my $bundlefile = "$basenamerev.git"; |
| 164 my @bundle_arg=$self->{options}{git_ref} ? |
| 165 (@{$self->{options}{git_ref}}) : '--all'; |
| 166 info(_g('bundling: %s'), join(' ', @bundle_arg)); |
| 167 system('git', 'bundle', 'create', "$old_cwd/$bundlefile", |
| 168 @bundle_arg, |
| 169 'HEAD', # ensure HEAD is included no matter what |
| 170 '--', # avoids ambiguity error when referring to eg, a debian branch |
| 171 ); |
| 172 subprocerr('git bundle') if $?; |
| 173 |
| 174 chdir($old_cwd) or syserr(_g("unable to chdir to `%s'"), $old_cwd); |
| 175 |
| 176 if (defined $tmp) { |
| 177 erasedir($tmp); |
| 178 pop_exit_handler(); |
| 179 } |
| 180 |
| 181 $self->add_file($bundlefile); |
| 182 if (defined $shallowfile) { |
| 183 $self->add_file($shallowfile); |
| 184 } |
| 185 } |
| 186 |
| 187 sub do_extract { |
| 188 my ($self, $newdirectory) = @_; |
| 189 my $fields = $self->{fields}; |
| 190 |
| 191 my $dscdir = $self->{basedir}; |
| 192 my $basenamerev = $self->get_basename(1); |
| 193 |
| 194 my @files = $self->get_files(); |
| 195 my ($bundle, $shallow); |
| 196 foreach my $file (@files) { |
| 197 if ($file =~ /^\Q$basenamerev\E\.git$/) { |
| 198 if (! defined $bundle) { |
| 199 $bundle = $file; |
| 200 } else { |
| 201 error(_g('format v3.0 (git) uses only one .git file')); |
| 202 } |
| 203 } elsif ($file =~ /^\Q$basenamerev\E\.gitshallow$/) { |
| 204 if (! defined $shallow) { |
| 205 $shallow = $file; |
| 206 } else { |
| 207 error(_g('format v3.0 (git) uses only one .gitshallow file')); |
| 208 } |
| 209 } else { |
| 210 error(_g('format v3.0 (git) unknown file: %s', $file)); |
| 211 } |
| 212 } |
| 213 if (! defined $bundle) { |
| 214 error(_g('format v3.0 (git) expected %s'), "$basenamerev.git"); |
| 215 } |
| 216 |
| 217 erasedir($newdirectory); |
| 218 |
| 219 # Extract git bundle. |
| 220 info(_g('cloning %s'), $bundle); |
| 221 system('git', 'clone', '--quiet', $dscdir . $bundle, $newdirectory); |
| 222 subprocerr('git bundle') if $?; |
| 223 |
| 224 if (defined $shallow) { |
| 225 # Move shallow info file into place, so git does not |
| 226 # try to follow parents of shallow refs. |
| 227 info(_g('setting up shallow clone')); |
| 228 system('cp', '-f', $dscdir . $shallow, "$newdirectory/.git/shallow"); |
| 229 subprocerr('cp') if $?; |
| 230 } |
| 231 |
| 232 sanity_check($newdirectory); |
| 233 } |
| 234 |
| 235 1; |
OLD | NEW |