Merge branch 'ma/t1450-quotefix'
[git] / perl / Git / SVN / Fetcher.pm
1 package Git::SVN::Fetcher;
2 use vars qw/@ISA $_ignore_regex $_include_regex $_preserve_empty_dirs
3             $_placeholder_filename @deleted_gpath %added_placeholder
4             $repo_id/;
5 use strict;
6 use warnings;
7 use SVN::Delta;
8 use Carp qw/croak/;
9 use File::Basename qw/dirname/;
10 use Git qw/command command_oneline command_noisy command_output_pipe
11            command_input_pipe command_close_pipe
12            command_bidi_pipe command_close_bidi_pipe
13            get_record/;
14 BEGIN {
15         @ISA = qw(SVN::Delta::Editor);
16 }
17
18 # file baton members: path, mode_a, mode_b, pool, fh, blob, base
19 sub new {
20         my ($class, $git_svn, $switch_path) = @_;
21         my $self = SVN::Delta::Editor->new;
22         bless $self, $class;
23         if (exists $git_svn->{last_commit}) {
24                 $self->{c} = $git_svn->{last_commit};
25                 $self->{empty_symlinks} =
26                                   _mark_empty_symlinks($git_svn, $switch_path);
27         }
28
29         # some options are read globally, but can be overridden locally
30         # per [svn-remote "..."] section.  Command-line options will *NOT*
31         # override options set in an [svn-remote "..."] section
32         $repo_id = $git_svn->{repo_id};
33         my $k = "svn-remote.$repo_id.ignore-paths";
34         my $v = eval { command_oneline('config', '--get', $k) };
35         $self->{ignore_regex} = $v;
36
37         $k = "svn-remote.$repo_id.include-paths";
38         $v = eval { command_oneline('config', '--get', $k) };
39         $self->{include_regex} = $v;
40
41         $k = "svn-remote.$repo_id.preserve-empty-dirs";
42         $v = eval { command_oneline('config', '--get', '--bool', $k) };
43         if ($v && $v eq 'true') {
44                 $_preserve_empty_dirs = 1;
45                 $k = "svn-remote.$repo_id.placeholder-filename";
46                 $v = eval { command_oneline('config', '--get', $k) };
47                 $_placeholder_filename = $v;
48         }
49
50         # Load the list of placeholder files added during previous invocations.
51         $k = "svn-remote.$repo_id.added-placeholder";
52         $v = eval { command_oneline('config', '--get-all', $k) };
53         if ($_preserve_empty_dirs && $v) {
54                 # command() prints errors to stderr, so we only call it if
55                 # command_oneline() succeeded.
56                 my @v = command('config', '--get-all', $k);
57                 $added_placeholder{ dirname($_) } = $_ foreach @v;
58         }
59
60         $self->{empty} = {};
61         $self->{dir_prop} = {};
62         $self->{file_prop} = {};
63         $self->{absent_dir} = {};
64         $self->{absent_file} = {};
65         require Git::IndexInfo;
66         $self->{gii} = $git_svn->tmp_index_do(sub { Git::IndexInfo->new });
67         $self->{pathnameencoding} = Git::config('svn.pathnameencoding');
68         $self;
69 }
70
71 # this uses the Ra object, so it must be called before do_{switch,update},
72 # not inside them (when the Git::SVN::Fetcher object is passed) to
73 # do_{switch,update}
74 sub _mark_empty_symlinks {
75         my ($git_svn, $switch_path) = @_;
76         my $bool = Git::config_bool('svn.brokenSymlinkWorkaround');
77         return {} if (!defined($bool)) || (defined($bool) && ! $bool);
78
79         my %ret;
80         my ($rev, $cmt) = $git_svn->last_rev_commit;
81         return {} unless ($rev && $cmt);
82
83         # allow the warning to be printed for each revision we fetch to
84         # ensure the user sees it.  The user can also disable the workaround
85         # on the repository even while git svn is running and the next
86         # revision fetched will skip this expensive function.
87         my $printed_warning;
88         chomp(my $empty_blob = `git hash-object -t blob --stdin < /dev/null`);
89         my ($ls, $ctx) = command_output_pipe(qw/ls-tree -r -z/, $cmt);
90         my $pfx = defined($switch_path) ? $switch_path : $git_svn->path;
91         $pfx .= '/' if length($pfx);
92         while (defined($_ = get_record($ls, "\0"))) {
93                 s/\A100644 blob $empty_blob\t//o or next;
94                 unless ($printed_warning) {
95                         print STDERR "Scanning for empty symlinks, ",
96                                      "this may take a while if you have ",
97                                      "many empty files\n",
98                                      "You may disable this with `",
99                                      "git config svn.brokenSymlinkWorkaround ",
100                                      "false'.\n",
101                                      "This may be done in a different ",
102                                      "terminal without restarting ",
103                                      "git svn\n";
104                         $printed_warning = 1;
105                 }
106                 my $path = $_;
107                 my (undef, $props) =
108                                $git_svn->ra->get_file($pfx.$path, $rev, undef);
109                 if ($props->{'svn:special'}) {
110                         $ret{$path} = 1;
111                 }
112         }
113         command_close_pipe($ls, $ctx);
114         \%ret;
115 }
116
117 # returns true if a given path is inside a ".git" directory
118 sub in_dot_git {
119         $_[0] =~ m{(?:^|/)\.git(?:/|$)};
120 }
121
122 # return value: 0 -- don't ignore, 1 -- ignore
123 # This will also check whether the path is explicitly included
124 sub is_path_ignored {
125         my ($self, $path) = @_;
126         return 1 if in_dot_git($path);
127         return 1 if defined($self->{ignore_regex}) &&
128                     $path =~ m!$self->{ignore_regex}!;
129         return 0 if defined($self->{include_regex}) &&
130                     $path =~ m!$self->{include_regex}!;
131         return 0 if defined($_include_regex) &&
132                     $path =~ m!$_include_regex!;
133         return 1 if defined($self->{include_regex});
134         return 1 if defined($_include_regex);
135         return 0 unless defined($_ignore_regex);
136         return 1 if $path =~ m!$_ignore_regex!o;
137         return 0;
138 }
139
140 sub set_path_strip {
141         my ($self, $path) = @_;
142         $self->{path_strip} = qr/^\Q$path\E(\/|$)/ if length $path;
143 }
144
145 sub open_root {
146         { path => '' };
147 }
148
149 sub open_directory {
150         my ($self, $path, $pb, $rev) = @_;
151         { path => $path };
152 }
153
154 sub git_path {
155         my ($self, $path) = @_;
156         if (my $enc = $self->{pathnameencoding}) {
157                 require Encode;
158                 Encode::from_to($path, 'UTF-8', $enc);
159         }
160         if ($self->{path_strip}) {
161                 $path =~ s!$self->{path_strip}!! or
162                   die "Failed to strip path '$path' ($self->{path_strip})\n";
163         }
164         $path;
165 }
166
167 sub delete_entry {
168         my ($self, $path, $rev, $pb) = @_;
169         return undef if $self->is_path_ignored($path);
170
171         my $gpath = $self->git_path($path);
172         return undef if ($gpath eq '');
173
174         # remove entire directories.
175         my ($tree) = (command('ls-tree', '-z', $self->{c}, "./$gpath")
176                          =~ /\A040000 tree ($::oid)\t\Q$gpath\E\0/);
177         if ($tree) {
178                 my ($ls, $ctx) = command_output_pipe(qw/ls-tree
179                                                      -r --name-only -z/,
180                                                      $tree);
181                 while (defined($_ = get_record($ls, "\0"))) {
182                         my $rmpath = "$gpath/$_";
183                         $self->{gii}->remove($rmpath);
184                         print "\tD\t$rmpath\n" unless $::_q;
185                 }
186                 print "\tD\t$gpath/\n" unless $::_q;
187                 command_close_pipe($ls, $ctx);
188         } else {
189                 $self->{gii}->remove($gpath);
190                 print "\tD\t$gpath\n" unless $::_q;
191         }
192         # Don't add to @deleted_gpath if we're deleting a placeholder file.
193         push @deleted_gpath, $gpath unless $added_placeholder{dirname($path)};
194         $self->{empty}->{$path} = 0;
195         undef;
196 }
197
198 sub open_file {
199         my ($self, $path, $pb, $rev) = @_;
200         my ($mode, $blob);
201
202         goto out if $self->is_path_ignored($path);
203
204         my $gpath = $self->git_path($path);
205         ($mode, $blob) = (command('ls-tree', '-z', $self->{c}, "./$gpath")
206                              =~ /\A(\d{6}) blob ($::oid)\t\Q$gpath\E\0/);
207         unless (defined $mode && defined $blob) {
208                 die "$path was not found in commit $self->{c} (r$rev)\n";
209         }
210         if ($mode eq '100644' && $self->{empty_symlinks}->{$path}) {
211                 $mode = '120000';
212         }
213 out:
214         { path => $path, mode_a => $mode, mode_b => $mode, blob => $blob,
215           pool => SVN::Pool->new, action => 'M' };
216 }
217
218 sub add_file {
219         my ($self, $path, $pb, $cp_path, $cp_rev) = @_;
220         my $mode;
221
222         if (!$self->is_path_ignored($path)) {
223                 my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
224                 delete $self->{empty}->{$dir};
225                 $mode = '100644';
226
227                 if ($added_placeholder{$dir}) {
228                         # Remove our placeholder file, if we created one.
229                         delete_entry($self, $added_placeholder{$dir})
230                                 unless $path eq $added_placeholder{$dir};
231                         delete $added_placeholder{$dir}
232                 }
233         }
234
235         { path => $path, mode_a => $mode, mode_b => $mode,
236           pool => SVN::Pool->new, action => 'A' };
237 }
238
239 sub add_directory {
240         my ($self, $path, $cp_path, $cp_rev) = @_;
241         goto out if $self->is_path_ignored($path);
242         my $gpath = $self->git_path($path);
243         if ($gpath eq '') {
244                 my ($ls, $ctx) = command_output_pipe(qw/ls-tree
245                                                      -r --name-only -z/,
246                                                      $self->{c});
247                 while (defined($_ = get_record($ls, "\0"))) {
248                         $self->{gii}->remove($_);
249                         print "\tD\t$_\n" unless $::_q;
250                         push @deleted_gpath, $gpath;
251                 }
252                 command_close_pipe($ls, $ctx);
253                 $self->{empty}->{$path} = 0;
254         }
255         my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
256         delete $self->{empty}->{$dir};
257         $self->{empty}->{$path} = 1;
258
259         if ($added_placeholder{$dir}) {
260                 # Remove our placeholder file, if we created one.
261                 delete_entry($self, $added_placeholder{$dir});
262                 delete $added_placeholder{$dir}
263         }
264
265 out:
266         { path => $path };
267 }
268
269 sub change_dir_prop {
270         my ($self, $db, $prop, $value) = @_;
271         return undef if $self->is_path_ignored($db->{path});
272         $self->{dir_prop}->{$db->{path}} ||= {};
273         $self->{dir_prop}->{$db->{path}}->{$prop} = $value;
274         undef;
275 }
276
277 sub absent_directory {
278         my ($self, $path, $pb) = @_;
279         return undef if $self->is_path_ignored($path);
280         $self->{absent_dir}->{$pb->{path}} ||= [];
281         push @{$self->{absent_dir}->{$pb->{path}}}, $path;
282         undef;
283 }
284
285 sub absent_file {
286         my ($self, $path, $pb) = @_;
287         return undef if $self->is_path_ignored($path);
288         $self->{absent_file}->{$pb->{path}} ||= [];
289         push @{$self->{absent_file}->{$pb->{path}}}, $path;
290         undef;
291 }
292
293 sub change_file_prop {
294         my ($self, $fb, $prop, $value) = @_;
295         return undef if $self->is_path_ignored($fb->{path});
296         if ($prop eq 'svn:executable') {
297                 if ($fb->{mode_b} != 120000) {
298                         $fb->{mode_b} = defined $value ? 100755 : 100644;
299                 }
300         } elsif ($prop eq 'svn:special') {
301                 $fb->{mode_b} = defined $value ? 120000 : 100644;
302         } else {
303                 $self->{file_prop}->{$fb->{path}} ||= {};
304                 $self->{file_prop}->{$fb->{path}}->{$prop} = $value;
305         }
306         undef;
307 }
308
309 sub apply_textdelta {
310         my ($self, $fb, $exp) = @_;
311         return undef if $self->is_path_ignored($fb->{path});
312         my $suffix = 0;
313         ++$suffix while $::_repository->temp_is_locked("svn_delta_${$}_$suffix");
314         my $fh = $::_repository->temp_acquire("svn_delta_${$}_$suffix");
315         # $fh gets auto-closed() by SVN::TxDelta::apply(),
316         # (but $base does not,) so dup() it for reading in close_file
317         open my $dup, '<&', $fh or croak $!;
318         my $base = $::_repository->temp_acquire("git_blob_${$}_$suffix");
319         # close_file may call temp_acquire on 'svn_hash', but because of the
320         # call chain, if the temp_acquire call from close_file ends up being the
321         # call that first creates the 'svn_hash' temp file, then the FileHandle
322         # that's created as a result will end up in an SVN::Pool that we clear
323         # in SVN::Ra::gs_fetch_loop_common.  Avoid that by making sure the
324         # 'svn_hash' FileHandle is already created before close_file is called.
325         my $tmp_fh = $::_repository->temp_acquire('svn_hash');
326         $::_repository->temp_release($tmp_fh, 1);
327
328         if ($fb->{blob}) {
329                 my ($base_is_link, $size);
330
331                 if ($fb->{mode_a} eq '120000' &&
332                     ! $self->{empty_symlinks}->{$fb->{path}}) {
333                         print $base 'link ' or die "print $!\n";
334                         $base_is_link = 1;
335                 }
336         retry:
337                 $size = $::_repository->cat_blob($fb->{blob}, $base);
338                 die "Failed to read object $fb->{blob}" if ($size < 0);
339
340                 if (defined $exp) {
341                         seek $base, 0, 0 or croak $!;
342                         my $got = ::md5sum($base);
343                         if ($got ne $exp) {
344                                 my $err = "Checksum mismatch: ".
345                                        "$fb->{path} $fb->{blob}\n" .
346                                        "expected: $exp\n" .
347                                        "     got: $got\n";
348                                 if ($base_is_link) {
349                                         warn $err,
350                                              "Retrying... (possibly ",
351                                              "a bad symlink from SVN)\n";
352                                         $::_repository->temp_reset($base);
353                                         $base_is_link = 0;
354                                         goto retry;
355                                 }
356                                 die $err;
357                         }
358                 }
359         }
360         seek $base, 0, 0 or croak $!;
361         $fb->{fh} = $fh;
362         $fb->{base} = $base;
363         [ SVN::TxDelta::apply($base, $dup, undef, $fb->{path}, $fb->{pool}) ];
364 }
365
366 sub close_file {
367         my ($self, $fb, $exp) = @_;
368         return undef if $self->is_path_ignored($fb->{path});
369
370         my $hash;
371         my $path = $self->git_path($fb->{path});
372         if (my $fh = $fb->{fh}) {
373                 if (defined $exp) {
374                         seek($fh, 0, 0) or croak $!;
375                         my $got = ::md5sum($fh);
376                         if ($got ne $exp) {
377                                 die "Checksum mismatch: $path\n",
378                                     "expected: $exp\n    got: $got\n";
379                         }
380                 }
381                 if ($fb->{mode_b} == 120000) {
382                         sysseek($fh, 0, 0) or croak $!;
383                         my $rd = sysread($fh, my $buf, 5);
384
385                         if (!defined $rd) {
386                                 croak "sysread: $!\n";
387                         } elsif ($rd == 0) {
388                                 warn "$path has mode 120000",
389                                      " but it points to nothing\n",
390                                      "converting to an empty file with mode",
391                                      " 100644\n";
392                                 $fb->{mode_b} = '100644';
393                         } elsif ($buf ne 'link ') {
394                                 warn "$path has mode 120000",
395                                      " but is not a link\n";
396                         } else {
397                                 my $tmp_fh = $::_repository->temp_acquire(
398                                         'svn_hash');
399                                 my $res;
400                                 while ($res = sysread($fh, my $str, 1024)) {
401                                         my $out = syswrite($tmp_fh, $str, $res);
402                                         defined($out) && $out == $res
403                                                 or croak("write ",
404                                                         Git::temp_path($tmp_fh),
405                                                         ": $!\n");
406                                 }
407                                 defined $res or croak $!;
408
409                                 ($fh, $tmp_fh) = ($tmp_fh, $fh);
410                                 Git::temp_release($tmp_fh, 1);
411                         }
412                 }
413
414                 $hash = $::_repository->hash_and_insert_object(
415                                 Git::temp_path($fh));
416                 $hash =~ /^$::oid$/ or die "not an object ID: $hash\n";
417
418                 Git::temp_release($fb->{base}, 1);
419                 Git::temp_release($fh, 1);
420         } else {
421                 $hash = $fb->{blob} or die "no blob information\n";
422         }
423         $fb->{pool}->clear;
424         $self->{gii}->update($fb->{mode_b}, $hash, $path) or croak $!;
425         print "\t$fb->{action}\t$path\n" if $fb->{action} && ! $::_q;
426         undef;
427 }
428
429 sub abort_edit {
430         my $self = shift;
431         $self->{nr} = $self->{gii}->{nr};
432         delete $self->{gii};
433         $self->SUPER::abort_edit(@_);
434 }
435
436 sub close_edit {
437         my $self = shift;
438
439         if ($_preserve_empty_dirs) {
440                 my @empty_dirs;
441
442                 # Any entry flagged as empty that also has an associated
443                 # dir_prop represents a newly created empty directory.
444                 foreach my $i (keys %{$self->{empty}}) {
445                         push @empty_dirs, $i if exists $self->{dir_prop}->{$i};
446                 }
447
448                 # Search for directories that have become empty due subsequent
449                 # file deletes.
450                 push @empty_dirs, $self->find_empty_directories();
451
452                 # Finally, add a placeholder file to each empty directory.
453                 $self->add_placeholder_file($_) foreach (@empty_dirs);
454
455                 $self->stash_placeholder_list();
456         }
457
458         $self->{git_commit_ok} = 1;
459         $self->{nr} = $self->{gii}->{nr};
460         delete $self->{gii};
461         $self->SUPER::close_edit(@_);
462 }
463
464 sub find_empty_directories {
465         my ($self) = @_;
466         my @empty_dirs;
467         my %dirs = map { dirname($_) => 1 } @deleted_gpath;
468
469         foreach my $dir (sort keys %dirs) {
470                 next if $dir eq ".";
471
472                 # If there have been any additions to this directory, there is
473                 # no reason to check if it is empty.
474                 my $skip_added = 0;
475                 foreach my $t (qw/dir_prop file_prop/) {
476                         foreach my $path (keys %{ $self->{$t} }) {
477                                 if (exists $self->{$t}->{dirname($path)}) {
478                                         $skip_added = 1;
479                                         last;
480                                 }
481                         }
482                         last if $skip_added;
483                 }
484                 next if $skip_added;
485
486                 # Use `git ls-tree` to get the filenames of this directory
487                 # that existed prior to this particular commit.
488                 my $ls = command('ls-tree', '-z', '--name-only',
489                                  $self->{c}, "$dir/");
490                 my %files = map { $_ => 1 } split(/\0/, $ls);
491
492                 # Remove the filenames that were deleted during this commit.
493                 delete $files{$_} foreach (@deleted_gpath);
494
495                 # Report the directory if there are no filenames left.
496                 push @empty_dirs, $dir unless (scalar %files);
497         }
498         @empty_dirs;
499 }
500
501 sub add_placeholder_file {
502         my ($self, $dir) = @_;
503         my $path = "$dir/$_placeholder_filename";
504         my $gpath = $self->git_path($path);
505
506         my $fh = $::_repository->temp_acquire($gpath);
507         my $hash = $::_repository->hash_and_insert_object(Git::temp_path($fh));
508         Git::temp_release($fh, 1);
509         $self->{gii}->update('100644', $hash, $gpath) or croak $!;
510
511         # The directory should no longer be considered empty.
512         delete $self->{empty}->{$dir} if exists $self->{empty}->{$dir};
513
514         # Keep track of any placeholder files we create.
515         $added_placeholder{$dir} = $path;
516 }
517
518 sub stash_placeholder_list {
519         my ($self) = @_;
520         my $k = "svn-remote.$repo_id.added-placeholder";
521         my $v = eval { command_oneline('config', '--get-all', $k) };
522         command_noisy('config', '--unset-all', $k) if $v;
523         foreach (values %added_placeholder) {
524                 command_noisy('config', '--add', $k, $_);
525         }
526 }
527
528 1;
529 __END__
530
531 =head1 NAME
532
533 Git::SVN::Fetcher - tree delta consumer for "git svn fetch"
534
535 =head1 SYNOPSIS
536
537     use SVN::Core;
538     use SVN::Ra;
539     use Git::SVN;
540     use Git::SVN::Fetcher;
541     use Git;
542
543     my $gs = Git::SVN->find_by_url($url);
544     my $ra = SVN::Ra->new(url => $url);
545     my $editor = Git::SVN::Fetcher->new($gs);
546     my $reporter = $ra->do_update($SVN::Core::INVALID_REVNUM, '',
547                                   1, $editor);
548     $reporter->set_path('', $old_rev, 0);
549     $reporter->finish_report;
550     my $tree = $gs->tmp_index_do(sub { command_oneline('write-tree') });
551
552     foreach my $path (keys %{$editor->{dir_prop}) {
553         my $props = $editor->{dir_prop}{$path};
554         foreach my $prop (keys %$props) {
555             print "property $prop at $path changed to $props->{$prop}\n";
556         }
557     }
558     foreach my $path (keys %{$editor->{empty}) {
559         my $action = $editor->{empty}{$path} ? 'added' : 'removed';
560         print "empty directory $path $action\n";
561     }
562     foreach my $path (keys %{$editor->{file_prop}) { ... }
563     foreach my $parent (keys %{$editor->{absent_dir}}) {
564         my @children = @{$editor->{abstent_dir}{$parent}};
565         print "cannot fetch directory $parent/$_: not authorized?\n"
566             foreach @children;
567     }
568     foreach my $parent (keys %{$editor->{absent_file}) { ... }
569
570 =head1 DESCRIPTION
571
572 This is a subclass of C<SVN::Delta::Editor>, which means it implements
573 callbacks to act as a consumer of Subversion tree deltas.  This
574 particular implementation of those callbacks is meant to store
575 information about the resulting content which B<git svn fetch> could
576 use to populate new commits and new entries for F<unhandled.log>.
577 More specifically:
578
579 =over
580
581 =item * Additions, removals, and modifications of files are propagated
582 to git-svn's index file F<$GIT_DIR/svn/$refname/index> using
583 B<git update-index>.
584
585 =item * Changes in Subversion path properties are recorded in the
586 C<dir_prop> and C<file_prop> fields (which are hashes).
587
588 =item * Addition and removal of empty directories are indicated by
589 entries with value 1 and 0 respectively in the C<empty> hash.
590
591 =item * Paths that are present but cannot be conveyed (presumably due
592 to permissions) are recorded in the C<absent_file> and
593 C<absent_dirs> hashes.  For each key, the corresponding value is
594 a list of paths under that directory that were present but
595 could not be conveyed.
596
597 =back
598
599 The interface is unstable.  Do not use this module unless you are
600 developing git-svn.
601
602 =head1 DEPENDENCIES
603
604 L<SVN::Delta> from the Subversion perl bindings,
605 the core L<Carp> and L<File::Basename> modules,
606 and git's L<Git> helper module.
607
608 C<Git::SVN::Fetcher> has not been tested using callers other than
609 B<git-svn> itself.
610
611 =head1 SEE ALSO
612
613 L<SVN::Delta>,
614 L<Git::SVN::Editor>.
615
616 =head1 INCOMPATIBILITIES
617
618 None reported.
619
620 =head1 BUGS
621
622 None.