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 |