/perl/Git/SVN/Fetcher.pm
Perl | 604 lines | 496 code | 75 blank | 33 comment | 75 complexity | cb5e3ac5a6aff073c7bdab9382c2305c MD5 | raw file
Possible License(s): LGPL-2.1, Apache-2.0, BSD-2-Clause, GPL-2.0
- package Git::SVN::Fetcher;
- use vars qw/@ISA $_ignore_regex $_preserve_empty_dirs $_placeholder_filename
- @deleted_gpath %added_placeholder $repo_id/;
- use strict;
- use warnings;
- use SVN::Delta;
- use Carp qw/croak/;
- use File::Basename qw/dirname/;
- use IO::File qw//;
- use Git qw/command command_oneline command_noisy command_output_pipe
- command_input_pipe command_close_pipe
- command_bidi_pipe command_close_bidi_pipe/;
- BEGIN {
- @ISA = qw(SVN::Delta::Editor);
- }
- # file baton members: path, mode_a, mode_b, pool, fh, blob, base
- sub new {
- my ($class, $git_svn, $switch_path) = @_;
- my $self = SVN::Delta::Editor->new;
- bless $self, $class;
- if (exists $git_svn->{last_commit}) {
- $self->{c} = $git_svn->{last_commit};
- $self->{empty_symlinks} =
- _mark_empty_symlinks($git_svn, $switch_path);
- }
- # some options are read globally, but can be overridden locally
- # per [svn-remote "..."] section. Command-line options will *NOT*
- # override options set in an [svn-remote "..."] section
- $repo_id = $git_svn->{repo_id};
- my $k = "svn-remote.$repo_id.ignore-paths";
- my $v = eval { command_oneline('config', '--get', $k) };
- $self->{ignore_regex} = $v;
- $k = "svn-remote.$repo_id.preserve-empty-dirs";
- $v = eval { command_oneline('config', '--get', '--bool', $k) };
- if ($v && $v eq 'true') {
- $_preserve_empty_dirs = 1;
- $k = "svn-remote.$repo_id.placeholder-filename";
- $v = eval { command_oneline('config', '--get', $k) };
- $_placeholder_filename = $v;
- }
- # Load the list of placeholder files added during previous invocations.
- $k = "svn-remote.$repo_id.added-placeholder";
- $v = eval { command_oneline('config', '--get-all', $k) };
- if ($_preserve_empty_dirs && $v) {
- # command() prints errors to stderr, so we only call it if
- # command_oneline() succeeded.
- my @v = command('config', '--get-all', $k);
- $added_placeholder{ dirname($_) } = $_ foreach @v;
- }
- $self->{empty} = {};
- $self->{dir_prop} = {};
- $self->{file_prop} = {};
- $self->{absent_dir} = {};
- $self->{absent_file} = {};
- require Git::IndexInfo;
- $self->{gii} = $git_svn->tmp_index_do(sub { Git::IndexInfo->new });
- $self->{pathnameencoding} = Git::config('svn.pathnameencoding');
- $self;
- }
- # this uses the Ra object, so it must be called before do_{switch,update},
- # not inside them (when the Git::SVN::Fetcher object is passed) to
- # do_{switch,update}
- sub _mark_empty_symlinks {
- my ($git_svn, $switch_path) = @_;
- my $bool = Git::config_bool('svn.brokenSymlinkWorkaround');
- return {} if (!defined($bool)) || (defined($bool) && ! $bool);
- my %ret;
- my ($rev, $cmt) = $git_svn->last_rev_commit;
- return {} unless ($rev && $cmt);
- # allow the warning to be printed for each revision we fetch to
- # ensure the user sees it. The user can also disable the workaround
- # on the repository even while git svn is running and the next
- # revision fetched will skip this expensive function.
- my $printed_warning;
- chomp(my $empty_blob = `git hash-object -t blob --stdin < /dev/null`);
- my ($ls, $ctx) = command_output_pipe(qw/ls-tree -r -z/, $cmt);
- local $/ = "\0";
- my $pfx = defined($switch_path) ? $switch_path : $git_svn->path;
- $pfx .= '/' if length($pfx);
- while (<$ls>) {
- chomp;
- s/\A100644 blob $empty_blob\t//o or next;
- unless ($printed_warning) {
- print STDERR "Scanning for empty symlinks, ",
- "this may take a while if you have ",
- "many empty files\n",
- "You may disable this with `",
- "git config svn.brokenSymlinkWorkaround ",
- "false'.\n",
- "This may be done in a different ",
- "terminal without restarting ",
- "git svn\n";
- $printed_warning = 1;
- }
- my $path = $_;
- my (undef, $props) =
- $git_svn->ra->get_file($pfx.$path, $rev, undef);
- if ($props->{'svn:special'}) {
- $ret{$path} = 1;
- }
- }
- command_close_pipe($ls, $ctx);
- \%ret;
- }
- # returns true if a given path is inside a ".git" directory
- sub in_dot_git {
- $_[0] =~ m{(?:^|/)\.git(?:/|$)};
- }
- # return value: 0 -- don't ignore, 1 -- ignore
- sub is_path_ignored {
- my ($self, $path) = @_;
- return 1 if in_dot_git($path);
- return 1 if defined($self->{ignore_regex}) &&
- $path =~ m!$self->{ignore_regex}!;
- return 0 unless defined($_ignore_regex);
- return 1 if $path =~ m!$_ignore_regex!o;
- return 0;
- }
- sub set_path_strip {
- my ($self, $path) = @_;
- $self->{path_strip} = qr/^\Q$path\E(\/|$)/ if length $path;
- }
- sub open_root {
- { path => '' };
- }
- sub open_directory {
- my ($self, $path, $pb, $rev) = @_;
- { path => $path };
- }
- sub git_path {
- my ($self, $path) = @_;
- if (my $enc = $self->{pathnameencoding}) {
- require Encode;
- Encode::from_to($path, 'UTF-8', $enc);
- }
- if ($self->{path_strip}) {
- $path =~ s!$self->{path_strip}!! or
- die "Failed to strip path '$path' ($self->{path_strip})\n";
- }
- $path;
- }
- sub delete_entry {
- my ($self, $path, $rev, $pb) = @_;
- return undef if $self->is_path_ignored($path);
- my $gpath = $self->git_path($path);
- return undef if ($gpath eq '');
- # remove entire directories.
- my ($tree) = (command('ls-tree', '-z', $self->{c}, "./$gpath")
- =~ /\A040000 tree ([a-f\d]{40})\t\Q$gpath\E\0/);
- if ($tree) {
- my ($ls, $ctx) = command_output_pipe(qw/ls-tree
- -r --name-only -z/,
- $tree);
- local $/ = "\0";
- while (<$ls>) {
- chomp;
- my $rmpath = "$gpath/$_";
- $self->{gii}->remove($rmpath);
- print "\tD\t$rmpath\n" unless $::_q;
- }
- print "\tD\t$gpath/\n" unless $::_q;
- command_close_pipe($ls, $ctx);
- } else {
- $self->{gii}->remove($gpath);
- print "\tD\t$gpath\n" unless $::_q;
- }
- # Don't add to @deleted_gpath if we're deleting a placeholder file.
- push @deleted_gpath, $gpath unless $added_placeholder{dirname($path)};
- $self->{empty}->{$path} = 0;
- undef;
- }
- sub open_file {
- my ($self, $path, $pb, $rev) = @_;
- my ($mode, $blob);
- goto out if $self->is_path_ignored($path);
- my $gpath = $self->git_path($path);
- ($mode, $blob) = (command('ls-tree', '-z', $self->{c}, "./$gpath")
- =~ /\A(\d{6}) blob ([a-f\d]{40})\t\Q$gpath\E\0/);
- unless (defined $mode && defined $blob) {
- die "$path was not found in commit $self->{c} (r$rev)\n";
- }
- if ($mode eq '100644' && $self->{empty_symlinks}->{$path}) {
- $mode = '120000';
- }
- out:
- { path => $path, mode_a => $mode, mode_b => $mode, blob => $blob,
- pool => SVN::Pool->new, action => 'M' };
- }
- sub add_file {
- my ($self, $path, $pb, $cp_path, $cp_rev) = @_;
- my $mode;
- if (!$self->is_path_ignored($path)) {
- my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
- delete $self->{empty}->{$dir};
- $mode = '100644';
- if ($added_placeholder{$dir}) {
- # Remove our placeholder file, if we created one.
- delete_entry($self, $added_placeholder{$dir})
- unless $path eq $added_placeholder{$dir};
- delete $added_placeholder{$dir}
- }
- }
- { path => $path, mode_a => $mode, mode_b => $mode,
- pool => SVN::Pool->new, action => 'A' };
- }
- sub add_directory {
- my ($self, $path, $cp_path, $cp_rev) = @_;
- goto out if $self->is_path_ignored($path);
- my $gpath = $self->git_path($path);
- if ($gpath eq '') {
- my ($ls, $ctx) = command_output_pipe(qw/ls-tree
- -r --name-only -z/,
- $self->{c});
- local $/ = "\0";
- while (<$ls>) {
- chomp;
- $self->{gii}->remove($_);
- print "\tD\t$_\n" unless $::_q;
- push @deleted_gpath, $gpath;
- }
- command_close_pipe($ls, $ctx);
- $self->{empty}->{$path} = 0;
- }
- my ($dir, $file) = ($path =~ m#^(.*?)/?([^/]+)$#);
- delete $self->{empty}->{$dir};
- $self->{empty}->{$path} = 1;
- if ($added_placeholder{$dir}) {
- # Remove our placeholder file, if we created one.
- delete_entry($self, $added_placeholder{$dir});
- delete $added_placeholder{$dir}
- }
- out:
- { path => $path };
- }
- sub change_dir_prop {
- my ($self, $db, $prop, $value) = @_;
- return undef if $self->is_path_ignored($db->{path});
- $self->{dir_prop}->{$db->{path}} ||= {};
- $self->{dir_prop}->{$db->{path}}->{$prop} = $value;
- undef;
- }
- sub absent_directory {
- my ($self, $path, $pb) = @_;
- return undef if $self->is_path_ignored($path);
- $self->{absent_dir}->{$pb->{path}} ||= [];
- push @{$self->{absent_dir}->{$pb->{path}}}, $path;
- undef;
- }
- sub absent_file {
- my ($self, $path, $pb) = @_;
- return undef if $self->is_path_ignored($path);
- $self->{absent_file}->{$pb->{path}} ||= [];
- push @{$self->{absent_file}->{$pb->{path}}}, $path;
- undef;
- }
- sub change_file_prop {
- my ($self, $fb, $prop, $value) = @_;
- return undef if $self->is_path_ignored($fb->{path});
- if ($prop eq 'svn:executable') {
- if ($fb->{mode_b} != 120000) {
- $fb->{mode_b} = defined $value ? 100755 : 100644;
- }
- } elsif ($prop eq 'svn:special') {
- $fb->{mode_b} = defined $value ? 120000 : 100644;
- } else {
- $self->{file_prop}->{$fb->{path}} ||= {};
- $self->{file_prop}->{$fb->{path}}->{$prop} = $value;
- }
- undef;
- }
- sub apply_textdelta {
- my ($self, $fb, $exp) = @_;
- return undef if $self->is_path_ignored($fb->{path});
- my $fh = $::_repository->temp_acquire('svn_delta');
- # $fh gets auto-closed() by SVN::TxDelta::apply(),
- # (but $base does not,) so dup() it for reading in close_file
- open my $dup, '<&', $fh or croak $!;
- my $base = $::_repository->temp_acquire('git_blob');
- if ($fb->{blob}) {
- my ($base_is_link, $size);
- if ($fb->{mode_a} eq '120000' &&
- ! $self->{empty_symlinks}->{$fb->{path}}) {
- print $base 'link ' or die "print $!\n";
- $base_is_link = 1;
- }
- retry:
- $size = $::_repository->cat_blob($fb->{blob}, $base);
- die "Failed to read object $fb->{blob}" if ($size < 0);
- if (defined $exp) {
- seek $base, 0, 0 or croak $!;
- my $got = ::md5sum($base);
- if ($got ne $exp) {
- my $err = "Checksum mismatch: ".
- "$fb->{path} $fb->{blob}\n" .
- "expected: $exp\n" .
- " got: $got\n";
- if ($base_is_link) {
- warn $err,
- "Retrying... (possibly ",
- "a bad symlink from SVN)\n";
- $::_repository->temp_reset($base);
- $base_is_link = 0;
- goto retry;
- }
- die $err;
- }
- }
- }
- seek $base, 0, 0 or croak $!;
- $fb->{fh} = $fh;
- $fb->{base} = $base;
- [ SVN::TxDelta::apply($base, $dup, undef, $fb->{path}, $fb->{pool}) ];
- }
- sub close_file {
- my ($self, $fb, $exp) = @_;
- return undef if $self->is_path_ignored($fb->{path});
- my $hash;
- my $path = $self->git_path($fb->{path});
- if (my $fh = $fb->{fh}) {
- if (defined $exp) {
- seek($fh, 0, 0) or croak $!;
- my $got = ::md5sum($fh);
- if ($got ne $exp) {
- die "Checksum mismatch: $path\n",
- "expected: $exp\n got: $got\n";
- }
- }
- if ($fb->{mode_b} == 120000) {
- sysseek($fh, 0, 0) or croak $!;
- my $rd = sysread($fh, my $buf, 5);
- if (!defined $rd) {
- croak "sysread: $!\n";
- } elsif ($rd == 0) {
- warn "$path has mode 120000",
- " but it points to nothing\n",
- "converting to an empty file with mode",
- " 100644\n";
- $fb->{mode_b} = '100644';
- } elsif ($buf ne 'link ') {
- warn "$path has mode 120000",
- " but is not a link\n";
- } else {
- my $tmp_fh = $::_repository->temp_acquire(
- 'svn_hash');
- my $res;
- while ($res = sysread($fh, my $str, 1024)) {
- my $out = syswrite($tmp_fh, $str, $res);
- defined($out) && $out == $res
- or croak("write ",
- Git::temp_path($tmp_fh),
- ": $!\n");
- }
- defined $res or croak $!;
- ($fh, $tmp_fh) = ($tmp_fh, $fh);
- Git::temp_release($tmp_fh, 1);
- }
- }
- $hash = $::_repository->hash_and_insert_object(
- Git::temp_path($fh));
- $hash =~ /^[a-f\d]{40}$/ or die "not a sha1: $hash\n";
- Git::temp_release($fb->{base}, 1);
- Git::temp_release($fh, 1);
- } else {
- $hash = $fb->{blob} or die "no blob information\n";
- }
- $fb->{pool}->clear;
- $self->{gii}->update($fb->{mode_b}, $hash, $path) or croak $!;
- print "\t$fb->{action}\t$path\n" if $fb->{action} && ! $::_q;
- undef;
- }
- sub abort_edit {
- my $self = shift;
- $self->{nr} = $self->{gii}->{nr};
- delete $self->{gii};
- $self->SUPER::abort_edit(@_);
- }
- sub close_edit {
- my $self = shift;
- if ($_preserve_empty_dirs) {
- my @empty_dirs;
- # Any entry flagged as empty that also has an associated
- # dir_prop represents a newly created empty directory.
- foreach my $i (keys %{$self->{empty}}) {
- push @empty_dirs, $i if exists $self->{dir_prop}->{$i};
- }
- # Search for directories that have become empty due subsequent
- # file deletes.
- push @empty_dirs, $self->find_empty_directories();
- # Finally, add a placeholder file to each empty directory.
- $self->add_placeholder_file($_) foreach (@empty_dirs);
- $self->stash_placeholder_list();
- }
- $self->{git_commit_ok} = 1;
- $self->{nr} = $self->{gii}->{nr};
- delete $self->{gii};
- $self->SUPER::close_edit(@_);
- }
- sub find_empty_directories {
- my ($self) = @_;
- my @empty_dirs;
- my %dirs = map { dirname($_) => 1 } @deleted_gpath;
- foreach my $dir (sort keys %dirs) {
- next if $dir eq ".";
- # If there have been any additions to this directory, there is
- # no reason to check if it is empty.
- my $skip_added = 0;
- foreach my $t (qw/dir_prop file_prop/) {
- foreach my $path (keys %{ $self->{$t} }) {
- if (exists $self->{$t}->{dirname($path)}) {
- $skip_added = 1;
- last;
- }
- }
- last if $skip_added;
- }
- next if $skip_added;
- # Use `git ls-tree` to get the filenames of this directory
- # that existed prior to this particular commit.
- my $ls = command('ls-tree', '-z', '--name-only',
- $self->{c}, "$dir/");
- my %files = map { $_ => 1 } split(/\0/, $ls);
- # Remove the filenames that were deleted during this commit.
- delete $files{$_} foreach (@deleted_gpath);
- # Report the directory if there are no filenames left.
- push @empty_dirs, $dir unless (scalar %files);
- }
- @empty_dirs;
- }
- sub add_placeholder_file {
- my ($self, $dir) = @_;
- my $path = "$dir/$_placeholder_filename";
- my $gpath = $self->git_path($path);
- my $fh = $::_repository->temp_acquire($gpath);
- my $hash = $::_repository->hash_and_insert_object(Git::temp_path($fh));
- Git::temp_release($fh, 1);
- $self->{gii}->update('100644', $hash, $gpath) or croak $!;
- # The directory should no longer be considered empty.
- delete $self->{empty}->{$dir} if exists $self->{empty}->{$dir};
- # Keep track of any placeholder files we create.
- $added_placeholder{$dir} = $path;
- }
- sub stash_placeholder_list {
- my ($self) = @_;
- my $k = "svn-remote.$repo_id.added-placeholder";
- my $v = eval { command_oneline('config', '--get-all', $k) };
- command_noisy('config', '--unset-all', $k) if $v;
- foreach (values %added_placeholder) {
- command_noisy('config', '--add', $k, $_);
- }
- }
- 1;
- __END__
- Git::SVN::Fetcher - tree delta consumer for "git svn fetch"
- =head1 SYNOPSIS
- use SVN::Core;
- use SVN::Ra;
- use Git::SVN;
- use Git::SVN::Fetcher;
- use Git;
- my $gs = Git::SVN->find_by_url($url);
- my $ra = SVN::Ra->new(url => $url);
- my $editor = Git::SVN::Fetcher->new($gs);
- my $reporter = $ra->do_update($SVN::Core::INVALID_REVNUM, '',
- 1, $editor);
- $reporter->set_path('', $old_rev, 0);
- $reporter->finish_report;
- my $tree = $gs->tmp_index_do(sub { command_oneline('write-tree') });
- foreach my $path (keys %{$editor->{dir_prop}) {
- my $props = $editor->{dir_prop}{$path};
- foreach my $prop (keys %$props) {
- print "property $prop at $path changed to $props->{$prop}\n";
- }
- }
- foreach my $path (keys %{$editor->{empty}) {
- my $action = $editor->{empty}{$path} ? 'added' : 'removed';
- print "empty directory $path $action\n";
- }
- foreach my $path (keys %{$editor->{file_prop}) { ... }
- foreach my $parent (keys %{$editor->{absent_dir}}) {
- my @children = @{$editor->{abstent_dir}{$parent}};
- print "cannot fetch directory $parent/$_: not authorized?\n"
- foreach @children;
- }
- foreach my $parent (keys %{$editor->{absent_file}) { ... }
- =head1 DESCRIPTION
- This is a subclass of C<SVN::Delta::Editor>, which means it implements
- callbacks to act as a consumer of Subversion tree deltas. This
- particular implementation of those callbacks is meant to store
- information about the resulting content which B<git svn fetch> could
- use to populate new commits and new entries for F<unhandled.log>.
- More specifically:
- =over
- =item * Additions, removals, and modifications of files are propagated
- to git-svn's index file F<$GIT_DIR/svn/$refname/index> using
- B<git update-index>.
- =item * Changes in Subversion path properties are recorded in the
- C<dir_prop> and C<file_prop> fields (which are hashes).
- =item * Addition and removal of empty directories are indicated by
- entries with value 1 and 0 respectively in the C<empty> hash.
- =item * Paths that are present but cannot be conveyed (presumably due
- to permissions) are recorded in the C<absent_file> and
- C<absent_dirs> hashes. For each key, the corresponding value is
- a list of paths under that directory that were present but
- could not be conveyed.
- =back
- The interface is unstable. Do not use this module unless you are
- developing git-svn.
- =head1 DEPENDENCIES
- L<SVN::Delta> from the Subversion perl bindings,
- the core L<Carp>, L<File::Basename>, and L<IO::File> modules,
- and git's L<Git> helper module.
- C<Git::SVN::Fetcher> has not been tested using callers other than
- B<git-svn> itself.
- =head1 SEE ALSO
- L<SVN::Delta>,
- L<Git::SVN::Editor>.
- =head1 INCOMPATIBILITIES
- None reported.
- =head1 BUGS
- None.