package SVN::Mirror::Ra; @ISA = ('SVN::Mirror'); $VERSION = '0.73'; use strict; use SVN::Core; use SVN::Repos; use SVN::Fs; use SVN::Delta; use SVN::Ra; use SVN::Client (); use constant OK => $SVN::_Core::SVN_NO_ERROR; sub new { my $class = shift; my $self = bless {}, $class; %$self = @_; $self->{source} =~ s{/+$}{}g; @{$self}{qw/source source_root source_path/} = _parse_source ($self->{source}); @{$self}{qw/rsource rsource_root rsource_path/} = _parse_source ($self->{rsource}) if $self->{rsource}; return $self; } sub _parse_source { my $source = shift; my ($root, $path) = split ('!', $source, 2); $path ||= ''; return (join('', $root, $path), $root, $path) } sub _store_source { my ($root, $path) = @_; return join('!', $root, $path); } sub _get_prop { my ($self, $ra, $path, $propname) = @_; } sub _is_descendent { my ($parent, $child) = @_; return 1 if $parent eq $child; $parent = "$parent/" unless $parent eq '/'; return $parent eq substr ($child, 0, length ($parent)); } sub _check_overlap { my ($self) = @_; my $fs = $self->{repos}->fs; my $root = $fs->revision_root ($fs->youngest_rev); for (map {$root->node_prop ($_, 'svm:source')} SVN::Mirror::list_mirror ($self->{repos})) { my (undef, $source_root, $source_path) = _parse_source ($_); next if $source_root ne $self->{source_root}; die "Mirroring overlapping paths not supported\n" if _is_descendent ($source_path, $self->{source_path}) || _is_descendent ($self->{source_path}, $source_path); } } sub init_state { my ($self, $txn) = @_; my $ra = $self->_new_ra (url => $self->{source}); my $uuid = $self->{source_uuid} = $ra->get_uuid (); my $source_root = $ra->get_repos_root (); my $path = $self->{source}; $txn->abort, die "source url not under source root" if substr($path, 0, length($source_root), '') ne $source_root; $self->{source_root} = $source_root; $self->{source_path} = $path; $self->{fromrev} = 0; # XXX: abort txn before dying $self->_check_overlap; # check if the url exists if ($ra->check_path ('', -1) != $SVN::Node::dir) { $txn->abort; die "$self->{source} is not a directory.\n"; } unless ($self->{source} eq $self->{source_root}) { undef $ra; # bizzare perlgc $ra = $self->_new_ra (url => $self->{source_root}); } # check if mirror source is already a mirror # older SVN::RA will return Reporter so prop would be undef my (undef, undef, $prop) = eval { $ra->get_dir ('', -1) }; warn "Unable to read $ra->{url}, relay support disabled\n" if $@; if ($prop && $prop->{'svm:mirror'}) { my $rroot; for ($prop->{'svm:mirror'} =~ m/^.*$/mg) { if (_is_descendent ($_, $self->{source_path})) { $rroot = $_; last; } elsif (_is_descendent ($self->{source_path}, $_)) { $txn->abort, die "Can't relay mirror outside mirror anchor $_"; } } if ($rroot) { $rroot =~ s|^/||; (undef, undef, $prop) = $ra->get_dir ($rroot, -1); $txn->abort, die "relayed mirror source doesn't not have svm:source" unless exists $prop->{'svm:source'}; @{$self}{qw/rsource rsource_root rsource_path/} = @{$self}{qw/source source_root source_path/}; $self->{rsource_uuid} = $uuid; $self->{source_path} =~ s|^/\Q$rroot\E||; @{$self}{qw/source source_uuid/} = @{$prop}{qw/svm:source svm:uuid/}; $self->{source} .= '!' if index ($self->{source}, '!') == -1; @{$self}{qw/source source_root source_path/} = _parse_source ($self->{source}.$self->{source_path}); $txn->abort, die "relayed source and source have same repository uuid" if $self->{source_uuid} eq $self->{rsource_uuid}; my $txnroot = $txn->root; $txnroot->change_node_prop ($self->{target_path}, 'svm:rsource', _store_source ($source_root, $path)); $txnroot->change_node_prop ($self->{target_path}, 'svm:ruuid', $uuid); $txn->change_prop ("svm:headrev", "$self->{rsource_uuid}:$self->{fromrev}\n"); return _store_source ($self->{source_root}, $self->{source_path}); } } @{$self}{qw/rsource rsource_root rsource_path/} = @{$self}{qw/source source_root source_path/}; $self->{rsource_uuid} = $self->{source_uuid}; $txn->change_prop ("svm:headrev", "$self->{rsource_uuid}:$self->{fromrev}\n"); return _store_source ($source_root, $path); } sub load_state { my ($self) = @_; my $prop = $self->{root}->node_proplist ($self->{target_path}); @{$self}{qw/source_uuid rsource_uuid/} = @{$prop}{qw/svm:uuid svm:ruuid/}; unless ($self->{rsource}) { @{$self}{qw/rsource rsource_root rsource_path/} = @{$self}{qw/source source_root source_path/}; $self->{rsource_uuid} = $self->{source_uuid}; } die "please upgrade the mirror state\n" if $self->{root}->node_prop ('/', join (':', 'svm:mirror', $self->{source_uuid}, $self->{source_path} || '/')); unless ($self->{ignore_lock}) { die "no headrev" unless defined $self->load_fromrev; } return; } sub _new_ra { my ($self, %arg) = @_; $self->{config} ||= SVN::Core::config_get_config(undef, $self->{pool}); $self->{auth} ||= $self->_new_auth; SVN::Ra->new( url => $self->{rsource}, auth => $self->{auth}, config => $self->{config}, %arg); } sub _new_auth { my ($self) = @_; # create a subpool that is not automatically destroyed my $pool = SVN::Pool::create (${$self->{pool}}); $pool->default; my ($baton, $ref) = SVN::Core::auth_open_helper([ SVN::Client::get_simple_provider (), SVN::Client::get_ssl_server_trust_file_provider (), SVN::Client::get_username_provider (), SVN::Client::get_simple_prompt_provider( $self->can('_simple_prompt'), 2), SVN::Client::get_ssl_server_trust_prompt_provider( $self->can('_ssl_server_trust_prompt') ), SVN::Client::get_ssl_client_cert_prompt_provider( $self->can('_ssl_client_cert_prompt'), 2 ), SVN::Client::get_ssl_client_cert_pw_prompt_provider( $self->can('_ssl_client_cert_pw_prompt'), 2 ), SVN::Client::get_username_prompt_provider( $self->can('_username_prompt'), 2), ]); $self->{auth_ref} = $ref; return $baton; } sub _simple_prompt { my ($cred, $realm, $default_username, $may_save, $pool) = @_; if (defined $default_username and length $default_username) { print "Authentication realm: $realm\n" if defined $realm and length $realm; $cred->username($default_username); } else { _username_prompt($cred, $realm, $may_save, $pool); } $cred->password(_read_password("Password for '" . $cred->username . "': ")); $cred->may_save($may_save); return OK; } sub _ssl_server_trust_prompt { my ($cred, $realm, $failures, $cert_info, $may_save, $pool) = @_; print "Error validating server certificate for '$realm':\n"; print " - The certificate is not issued by a trusted authority. Use the\n", " fingerprint to validate the certificate manually!\n" if ($failures & $SVN::Auth::SSL::UNKNOWNCA); print " - The certificate hostname does not match.\n" if ($failures & $SVN::Auth::SSL::CNMISMATCH); print " - The certificate is not yet valid.\n" if ($failures & $SVN::Auth::SSL::NOTYETVALID); print " - The certificate has expired.\n" if ($failures & $SVN::Auth::SSL::EXPIRED); print " - The certificate has an unknown error.\n" if ($failures & $SVN::Auth::SSL::OTHER); printf( "Certificate information:\n". " - Hostname: %s\n". " - Valid: from %s until %s\n". " - Issuer: %s\n". " - Fingerprint: %s\n", map $cert_info->$_, qw(hostname valid_from valid_until issuer_dname fingerprint) ); print( $may_save ? "(R)eject, accept (t)emporarily or accept (p)ermanently? " : "(R)eject or accept (t)emporarily? " ); my $choice = lc(substr( || 'R', 0, 1)); if ($choice eq 't') { $cred->may_save(0); $cred->accepted_failures($failures); } elsif ($may_save and $choice eq 'p') { $cred->may_save(1); $cred->accepted_failures($failures); } return OK; } sub _ssl_client_cert_prompt { my ($cred, $realm, $may_save, $pool) = @_; print "Client certificate filename: "; chomp(my $filename = ); $cred->cert_file($filename); return OK; } sub _ssl_client_cert_pw_prompt { my ($cred, $realm, $may_save, $pool) = @_; $cred->password(_read_password("Passphrase for '%s': ")); return OK; } sub _username_prompt { my ($cred, $realm, $may_save, $pool) = @_; print "Authentication realm: $realm\n" if defined $realm and length $realm; print "Username: "; chomp(my $username = ); $username = '' unless defined $username; $cred->username($username); return OK; } sub _read_password { my ($prompt) = @_; print $prompt; require Term::ReadKey; Term::ReadKey::ReadMode('noecho'); my $password = ''; while (defined(my $key = Term::ReadKey::ReadKey(0))) { last if $key =~ /[\012\015]/; $password .= $key; } Term::ReadKey::ReadMode('restore'); print "\n"; return $password; } sub _revmap { my ($self, $rev, $ra) = @_; $ra ||= $self->{cached_ra}; $SVN::Core::VERSION ge '1.1.0' ? $ra->rev_prop ($rev, 'svm:headrev') : $ra->rev_proplist ($rev)->{'svm:headrev'}; } sub committed { my ($self, $revmap, $date, $sourcerev, $rev) = @_; $self->{headrev} = $rev; # Even though we set this on the transaction, we need to set it # again after commit, since the fs will always make it the current # time after committing. $self->{fs}->change_rev_prop($rev, 'svn:date', $date); $self->unlock ('mirror'); print "Committed revision $rev from revision $sourcerev.\n"; } our $debug; sub mirror { my ($self, $fromrev, $paths, $rev, $author, $date, $msg, $ppool) = @_; my $ra; if ($debug and eval { require BSD::Resource; 1 }) { my ($usertime, $systemtime, $maxrss, $ixrss, $idrss, $isrss, $minflt, $majflt, $nswap, $inblock, $oublock, $msgsnd, $msgrcv, $nsignals, $nvcsw, $nivcsw) = BSD::Resource::getrusage(); print ">>> mirroring $rev:\n"; print ">>> $usertime $systemtime $maxrss $ixrss $idrss $isrss\n"; } my $pool = SVN::Pool->new_default ($ppool); my ($newrev, $revmap); $ra = $self->{cached_ra} if exists $self->{cached_ra_url} && $self->{cached_ra_url} eq $self->{rsource}; if ($ra && $self->{rsource} =~ m/^http/ && --$self->{cached_life} == 0) { undef $ra; } $ra ||= $self->_new_ra; $revmap = $self->_revmap ($rev, $ra) if $self->_relayed; $revmap ||= ''; my $txn = $self->{repos}->fs_begin_txn_for_commit ($self->{fs}->youngest_rev, $author, $msg); $txn->change_prop('svk:commit', '*') if $self->{fs}->revision_prop(0, 'svk:notify-commit'); $txn->change_prop('svn:date', $date); # XXX: sync remote headrev too $txn->change_prop('svm:headrev', $revmap."$self->{rsource_uuid}:$rev\n"); $txn->change_prop('svm:incomplete', '*') if $self->{rev_incomplete}; my $editor = SVN::Mirror::Ra::NewMirrorEditor->new ($self->{repos}->get_commit_editor2 ($txn, '', $self->{target_path}, $author, $msg, sub { $newrev = $_[0]; $self->committed ($revmap, $date, $rev, @_) })); $self->{working} = $rev; $editor->{mirror} = $self; @{$self}{qw/cached_ra cached_ra_url/} = ($ra, $self->{rsource}); $self->{cached_life} ||= 100; # some leak in ra_dav, so reconnect every 100 revs $editor->{target} ||= '' if $SVN::Core::VERSION gt '0.36.0'; =begin NOTES The structure of mod_lists: * Key is the path of a changed path, a relative path to source_path. This is what methods in MirrorEditor get its path, therefore easier for them to look up information. * Value is a hash, containing the following values: * action: 'A'dd, 'M'odify, 'D'elete, 'R'eplace * remote_path: The path on remote depot * remote_rev: The revision on remote depot * local_rev: * Not Add: -1 * Add but source is not in local depot: undef * Add and source is in local depot: the source revision in local depot * local_path: The mapped path of key, ie. the changed path, in local depot. * local_source_path: * Source path is not in local depot: undef * Source path is in local depot: a string * source_node_kind: Only meaningful if action is 'A'. =cut $editor->{mod_lists} = {}; foreach ( keys %$paths ) { my $spool = SVN::Pool->new_default; my $item = $paths->{$_}; s/\n/ /g; # XXX: strange edge case my $href; my $svn_lpath = my $local_path = $_; if ( $editor->{anchor} ) { $svn_lpath = $self->{rsource_root} . $svn_lpath; $svn_lpath =~ s|^\Q$editor->{anchor}\E/?||; my $source_path = $self->{rsource_path} || "/"; $local_path =~ s|^\Q$source_path\E|$self->{target_path}|; } else { $svn_lpath =~ s|^\Q$self->{rsource_path}\E/?||; $local_path = "$self->{target_path}/$svn_lpath"; } my $local_rev = -1; unless ($item->copyfrom_rev == -1) { $local_rev = $self->find_local_rev ($item->copyfrom_rev, $self->{rsource_uuid}); } # XXX: the logic of the code here is a mess! my ($action, $rpath, $rrev, $lrev) = @$href{qw/action remote_path remote_rev local_rev local_path/} = ( $item->action, $item->copyfrom_path, $item->copyfrom_rev, $local_rev, $local_path, ); # workaround fsfs remoet_path inconsistencies $rpath = "/$rpath" if $rpath && substr ($rpath, 0, 1) ne '/'; my ($src_lpath, $source_node_kind) = (undef, $SVN::Node::unknown); # XXX: should check if the copy is within the anchor before resolving lrev if ( defined $lrev && $lrev != -1 ) { $src_lpath = $rpath; # copy within mirror anchor if ($src_lpath =~ s|^\Q$self->{rsource_path}\E/|$self->{target_path}/|) { # $source_node_kind is used for deciding if we need reporter later my $rev_root = $self->{fs}->revision_root ($lrev); $source_node_kind = $rev_root->check_path ($src_lpath); } else { ($src_lpath, $href->{local_rev}) = (undef, undef); } } elsif ($rrev != -1) { # The source is not in local depot. Invalidate this # copy. ($src_lpath, $href->{local_rev}) = $self->{cb_copy_notify} ? $self->{cb_copy_notify}->($self, $local_path, $rpath, $rrev) : (undef, undef) } $src_lpath =~ s/%/%25/g if defined $src_lpath; @$href{qw/local_source_path source_node_kind/} = ( $src_lpath, $source_node_kind ); # XXX: the loop should not reached here if changed path is # not interesting to us, skip them at the beginning the the loop if ( $_ eq $self->{rsource_path} or index ("$_/", "$self->{rsource_path}/") == 0 ) { $editor->{mod_lists}{$svn_lpath} = $href; $editor->{mod_lists}{$svn_lpath}{path} = $svn_lpath; } elsif ($rrev != -1 && $href->{action} eq 'A' && index ($self->{rsource_path}, "$_/") == 0) { # special case for the parent of the anchor is copied. my $reanchor = $self->{rsource_path}; my $path = length $svn_lpath ? "$svn_lpath/$reanchor" : $reanchor; $reanchor =~ s{^\Q$_\E/}{}; $href->{remote_path} .= '/'.$reanchor; $href->{local_path} = $self->{target_path}; $editor->{mod_lists}{$path} = $href; $editor->{mod_lists}{$path}{path} = $path; } } unless (keys %{$editor->{mod_lists}}) { my $root = $editor->open_root($self->{headrev}); $editor->change_dir_prop ($root, svm => undef); $editor->close_directory($root); $editor->close_edit; } else { my @mod_list = sort keys %{$editor->{mod_lists}}; # mark item as directory that we are sure about. # do not use !isdir for deciding the item is _not_ a directory. for my $parent (@mod_list) { for (@mod_list) { next if $parent eq $_; if (index ("$_/", "$parent/") == 0) { $editor->{mod_lists}{$parent}{isdir} = 1; last; } } } if (($self->{skip_to} && $self->{skip_to} <= $rev) || grep { my $href = $editor->{mod_lists}{$_}; !( ( ($href->{action} eq 'A' || $href->{action} eq 'R') && ((defined $href->{local_rev} && $href->{local_rev} != -1 && $href->{source_node_kind} == $SVN::Node::dir) || ($href->{isdir}) )) || $href->{action} eq 'D' ) } @mod_list ) { my $pool = SVN::Pool->new_default_sub; my $start = $fromrev || ($self->{skip_to} ? $fromrev : $rev-1); my $reporter = $ra->do_update ($rev, $editor->{target} || '', 1, $editor); my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : (); if ($fromrev == 0 || $start == 0) { $reporter->set_path ('', $rev, 1, @lock); # start_empty } else { $reporter->set_path ('', $start, 0, @lock); } $reporter->finish_report (); } else { # Copies only. Don't bother fetching full diff through network. my $edit = SVN::Simple::Edit->new (_editor => [$editor], missing_handler => \&SVN::Simple::Edit::open_missing ); $edit->open_root ($self->{headrev}); foreach (@mod_list) { my $href = $editor->{mod_lists}{$_}; my $action = $href->{action}; if ($action eq 'D' || $action eq 'R') { # XXX: bad pool usage here, but svn::simple::edit sucks $edit->delete_entry($_); } # can't use a new pool for these, because we need to # keep the parent. switch to svk dynamic editor when we can if ($action eq 'A' || $action eq 'R') { my $ret; if (defined $href->{local_rev} && $href->{local_rev} != -1) { $ret = $edit->copy_directory( $_, $href->{local_source_path}, $href->{local_rev}); } else { $ret = $edit->add_directory($_); } $edit->close_directory($_) if $ret; } } $edit->close_edit (); } } return if defined $self->{mirror}{skip_to} && $self->{mirror}{skip_to} > $rev; my $prop; $prop = $ra->rev_proplist ($rev) if $self->{revprop}; for (@{$self->{revprop}}) { $self->{fs}->change_rev_prop($newrev, $_, $prop->{$_}) if exists $prop->{$_}; } } sub _relayed { $_[0]->{rsource} ne $_[0]->{source} } sub _debug_args { map { $_ = '' if !defined($_) } @_ } sub get_merge_back_editor { my ($self, $path, $msg, $committed) = @_; die "relayed merge back not supported yet" if $self->_relayed; @{$self}{qw/cached_ra cached_ra_url/} = ($self->_new_ra ( url => "$self->{source}$path"), "$self->{source}$path" ); $self->{commit_ra} = $self->{cached_ra}; $self->load_fromrev; my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef, 0) : (); return ($self->{fromrev}, SVN::Delta::Editor->new ($self->{cached_ra}->get_commit_editor ($msg, $committed, @lock))); } sub switch { my ($self, $url) = @_; my $ra = $self->_new_ra (url => $url); # XXX: get proper uuid like init_state die "uuid is different" unless $ra->get_uuid eq $self->{source_uuid}; # warn "===> switching from $self->{source} to $url"; # get a txn, change rsource and rsource_uuidto new url } sub get_latest_rev { my ($self, $ra) = @_; # don't care about real last-modified rev num unless in skip to mode. return $ra->get_latest_revnum unless $self->{skip_to}; my ($rev, $headrev); my $offset = 2; # there were once get_log2, but it then was refactored by the svn_ra # overhaul. We have to check the version. # also, it's harmful to make use of the limited get_log for svn 1.2 # vs svnserve 1.1, it retrieves all logs and leave the connection # in an inconsistent state. if ($SVN::Core::VERSION ge '1.2.0' && $self->{rsource} !~ m/^svn/) { $ra->get_log ([''], $ra->get_latest_revnum, 0, 1, 0, 1, sub { $rev = $_[1] }); } else { until (defined $rev) { $headrev = $ra->get_latest_revnum unless defined $headrev; $headrev -= $offset; $ra->get_log ([''], -1, $headrev, ($SVN::Core::VERSION ge '1.2.0') ? (0) : (), 0, 1, sub { $rev = $_[1] unless defined $rev}); if ( $offset < $headrev ) { $offset*=2; } else { $offset = 2; } } } die 'fatal: unable to find last-modified revision' unless defined $rev; return $rev; } sub run { my $self = shift; my $ra = $self->_new_ra; my $latestrev = $self->get_latest_rev ($ra); $self->lock ('sync'); $self->load_fromrev; # there were code here to use find_local_rev, but it will get base that # is too old for use, if there are relocate happening. # but this might cause race condition, while we also have lock now, need # to take a closer look. $self->{headrev} = $self->{fs}->youngest_rev; if ($self->{skip_to} && $self->{skip_to} =~ m/^HEAD(?:-(\d+))?/) { $self->{skip_to} = $latestrev - ($1 || 0); } my $startrev = ($self->{skip_to} || 0); $startrev = $self->{fromrev}+1 if $self->{fromrev}+1 > $startrev; my $endrev = shift || -1; if ($endrev && $endrev =~ m/^HEAD(?:-(\d+))?/) { $endrev = $latestrev - ($1 || 0); } $endrev = $latestrev if $endrev == -1; print "Syncing $self->{source}".($self->_relayed ? " via $self->{rsource}\n" : "\n"); $self->unlock ('sync'), return unless $endrev == -1 || $startrev <= $endrev; print "Retrieving log information from $startrev to $endrev\n"; my $firsttime = 1; eval { $ra->get_log ([''], $startrev, $endrev, ($SVN::Core::VERSION ge '1.2.0') ? (0) : (), 1, 1, sub { my ($paths, $rev, $author, $date, $msg, $pool) = @_; # for the first time, skip_to might not hit # active revision in the tree. adjust to make it so. if ($firsttime) { $self->{skip_to} = $rev if defined $self->{skip_to}; $firsttime = 0; } # move the anchor detection stuff to &mirror ? if (defined $self->{skip_to} && $rev <= $self->{skip_to}) { # XXX: get the logs for skipped changes $self->{rev_incomplete} = 1; $author = 'svm'; $msg = sprintf('SVM: skipping changes %d-%d for %s', $self->{fromrev}, $rev, $self->{rsource}); } else { delete $self->{rev_incomplete}; } $self->mirror($self->{fromrev}, $paths, $rev, $author, $date, $msg, $pool); $self->{fromrev} = $rev; }); }; delete $self->{cached_ra}; delete $self->{cached_ra_url}; $self->unlock ('sync'); return unless $@; if ($@ =~ /no item/) { print "Mirror source already removed.\n"; undef $@; } else { die $@; } } sub DESTROY { } package SVN::Mirror::Ra::NewMirrorEditor; our @ISA = ('SVN::Delta::Editor'); use strict; #use Smart::Comments '###', '####'; sub new { my $class = shift; my $self = $class->SUPER::new(@_); return $self; } sub set_target_revision { return; } # class method # _visited_path_item( $path, $pass_thru, $copied, $ref_mod ) # ref_mod is the reference item in mod_list. sub _visited_path_item { return { path => shift, pass_thru => shift, copied => shift, ref_mod => shift, }; } # object method # visit_path( $path, @args ) # @args are as the same as _visited_path_item(). '-inherit' for # inheriting from the counterpart of the last path. # # Call this method whenever a directory is entered. sub visit_path { my ($self, $path) = (shift, shift); my $last = $self->{visited_paths}[-1]; my @inherited = @$last{qw/pass_thru copied ref_mod/}; my @args = map { my $o = shift @inherited; ( ( $_ || '' ) eq '-inherit' ) ? $o : $_ } @_; push @{$self->{visited_paths}}, _visited_path_item( $path, @args ); return $self; } # Call this method whenever a directory is left. sub leave_path { my ($self) = @_; my $last = $self->{visited_paths}[-1]; pop @{$self->{visited_paths}}; return $self; } sub is_pass_thru { $_[0]->{visited_paths}[-1]{pass_thru} } sub is_copied { $_[0]->{visited_paths}[-1]{copied} } sub _remove_entries_in_path { my ($self, $path, $pb, $pool) = @_; foreach ( sort grep $self->{mod_lists}{$_}{action} eq 'D', keys %{$self->{mod_lists}} ) { next unless m{^\Q$path\E/([^/]+)$}; $self->delete_entry ($_, -1, $pb, $pool); } } # Return undef if not in modified list, action otherwise. # 'A'dd, 'D'elete, 'R'eplace, 'M'odify sub _in_modified_list { my ($self, $path) = @_; if (exists $self->{mod_lists}{$path}) { return $self->{mod_lists}{$path}{action}; } else { return; } } # From source to target. Given a path what svn lib gives, get a path # where it should be. sub _translate_rel_path { my ($self, $path) = @_; if ( exists $self->{mod_lists}{$path} ) { return $self->{mod_lists}{$path}{local_path}; } else { if ( $self->{anchor} ) { $path = "$self->{anchor}/$path"; $path =~ s|\Q$self->{mirror}{rsource_root}\E||; } else { $path = "$self->{mirror}{rsource_path}/$path"; } $path =~ s|^\Q$self->{mirror}{rsource_path}\E|$self->{mirror}{target_path}|; return $path; } } # If there's modifications under specified path, return true. sub _contains_mod_in_path { my ($self, $path) = @_; foreach ( reverse sort keys %{$self->{mod_lists}} ) { return $self->{mod_lists}{$_} if index ($_, $path, 0) == 0; } return; } # Given a path, return true if it is a copied path. sub _is_copy { my ($self, $path) = @_; return exists $self->{mod_lists}{$path} && $self->{mod_lists}{$path}{remote_path}; } # Given a path, return source path and revision number in local depot. sub _get_copy_path_rev { my ($self, $path) = @_; return unless exists $self->{mod_lists}{$path}; my ($cp_path, $cp_rev) = @{$self->{mod_lists}{$path}}{qw/local_source_path local_rev/}; return ($cp_path, $cp_rev); } sub open_root { my ($self, $remoterev, $pool) =@_; ### open_root()... ### $remoterev # {visited_paths} keeps track of visited paths. Parents at the # beginning of array, and children the end. '' means '/'. $path # passed to add_directory() and other methods are in the form of # 'deep/path' instead of '/deep/path'. $self->{visited_paths} = [ _visited_path_item( '', undef) ]; $self->{root} = $self->SUPER::open_root($self->{mirror}{headrev}, $pool); } sub open_file { my ($self,$path,$pb,undef,$pool) = @_; ### open_file()... ### $path return undef unless $pb; my $action = $self->_in_modified_list ($path); ### Action for path is action... ### $path ### $action if ( $self->is_pass_thru() && !$action ) { #### Skip this file... return undef; } if ( ($action || '') eq 'R' ) { my $item = $self->{mod_lists}{$path}; return $self->add_file($path, $pb, undef, -1, $pool) unless defined $item->{remote_rev} xor defined $item->{local_rev}; # If we are replacing with history and the source is out side # of the mirror, assume assume a simple replace. Note that # the server would send a delete+add if the source is actually # unrelated. } ++$self->{changes}; return $self->SUPER::open_file ($path, $pb, $self->{mirror}{headrev}, $pool); } sub change_dir_prop { my $self = shift; my $baton = shift; ### change_dir_prop()... ### $_[0] ### $_[1] # filter wc specified stuff return unless $baton; return if $_[0] =~ /^svm:/; return if $_[0] =~ /^svn:(?:entry|wc):/; return $self->SUPER::change_dir_prop ($baton, @_) } sub change_file_prop { my $self = shift; ### change_file_prop()... ### $_[1] ### $_[2] # filter wc specified stuff return unless $_[0]; return if $_[1] =~ /^svn:(?:entry|wc):/; return $self->SUPER::change_file_prop (@_) } sub apply_textdelta { my $self = shift; return undef unless $_[0]; ### apply_textdelta()... ### $_[0] $self->SUPER::apply_textdelta (@_); } sub open_directory { my ($self,$path,$pb,undef,$pool) = @_; ### open_directory()... ### $path return undef unless $pb; if ( ($self->_in_modified_list($path) || '') eq 'R' ) { ### Found an R item... # if the path is replaced with history, from outside the # mirror anchor... HATE my $bogus_copy = $self->_is_copy($path) && !defined $self->{mod_lists}{$path}{local_source_path}; if ($bogus_copy ) { ##### Is a bogus... $self->visit_path( $path, 0, 1, # copy but source not in local $self->{mod_lists}{$path} ); } else { ##### Call add_directory()... return $self->add_directory($path, $pb, undef, -1, $pool); } } my $dir_baton = $self->SUPER::open_directory ($path, $pb, $self->{mirror}{headrev}, $pool); $self->visit_path( $path, '-inherit', '-inherit', '-inherit' ); ### Visit info for this path: $self->{visited_paths}[-1] if ($self->is_pass_thru()) { ### Under latest copy, remove entries under path... # $self->_enter_new_copied_path(); $self->_remove_entries_in_path ($path, $dir_baton, $pool); } ++$self->{changes}; return $dir_baton; } # Return an array of two elements: if pass thru and if copied. sub _visit_info_for_dir { my $copyrev = shift; if ( !defined($copyrev) ) { ### Copy source is not in local depot... return ( 0, 1 ); # copy but source not in local } elsif ( $copyrev == -1 ) { ### Usual action... return ( 0, 0 ); # not a copy } else { ### Copy source is in local depot... return ( 1, 1 ); # copy with source in local } } =comment Please keep in mind that subversion's update editor is optimized for file system. That's why we need to keep many data in add_directory() because we need to deal with many different situations. It means open_directory() or add_directory() (as well as counterparts for files) is called depends on the existence of the target directory. An add_diectory() call in a file system may be not necessary in a repostiroy. If a directory is copied from another directory in a repository, every directory or file under it needs a add_directory() or add_file() call, but absolutely not necessary in another repository, since they are brought automatically by the copy operation. If some entries are deleted under the copied diectory, no add_directory() and add_file() is necessary in a file system, but explicit calls to delete_entry() are needed in a repository. =cut sub add_directory { my $self = shift; my $path = shift; my $pb = shift; my (undef,undef,$pool) = @_; my ($copypath, $copyrev) = $self->_get_copy_path_rev( $path ); my $crazy_replace; ### add_directory()... ### $path ### $copypath ### $copyrev return undef unless $pb; # rules: # in mod_lists, not under copied path: # * A: add_directory() # * M: open_directory() # * R: delete_entry($path), add_directory() # under copied path, with local copy source: # * in mod_lists: # A: add_directory() # M: open_directory() # R: delete_entry($path), add_directory() # * not in mod_lists: # * Modifications in the path: # * open_directory(). # * No modification in the path: # * Ignore unconditionally. # under copied path, without local copy source: # ( add_directory() unconditionally ) my $method = 'add_directory'; my $action = $self->_in_modified_list ($path); my $do_remove_items = undef; if (defined $self->{mirror}{skip_to} && $self->{mirror}{skip_to} >= $self->{mirror}{working}) { # no-op. } elsif ( $action ) { ### Change item. Action : $action my $item = $self->{mod_lists}{$path}; ### More info: $item my @visit_info; if ( $action eq 'A' ) { ### Add a directory... @visit_info = _visit_info_for_dir( $copyrev ); if ( $visit_info[0] && $visit_info[1] ) { $do_remove_items = 1; splice (@_, 0, 2, $copypath, $copyrev); } push @visit_info, $item; } elsif ( $action eq 'M' ) { ### Modify a directory... $method = 'open_directory'; @visit_info = ( '-inherit', # as parent '-inherit', # as parent $item ); $do_remove_items = 1; } elsif ( $action eq 'R' ) { ### Replace a directory... $self->delete_entry ($path, $self->{mirror}{headrev}, $pb, $pool); @visit_info = _visit_info_for_dir( $copyrev ); if ( $visit_info[0] && $visit_info[1] ) { $do_remove_items = 1; splice (@_, 0, 2, @$item{qw/local_source_path local_rev/}); } if ($copypath) { ++$crazy_replace; $visit_info[0] = 0; # don't pass thru for crazy replace } push @visit_info, $item; } $self->visit_path( $path, @visit_info ); } elsif ( $self->is_pass_thru() ) { ### Is pass thru... # We are supposed to pass everything, but check if we have # modifications under current path. if ( (my $ref_mod = $self->_contains_mod_in_path ($path)) ) { ### Contains modifications under path... #### ref_mod : $ref_mod $do_remove_items = 1; if ( $ref_mod->{path} ne $path ) { $ref_mod = undef } $self->visit_path( $path, '-inherit', # should not pass thru '-inherit', # yes, copied $ref_mod # whatever previous node is ); $method = 'open_directory'; } else { ### No modifications under path. Bypass anything under it... return; } } elsif ( $self->is_copied() ) { ### Not pass thru, but is copied. Modifications under path... $method = 'open_directory'; $self->visit_path( $path, '-inherit', # pass_thru '-inherit', # copied '-inherit' # ref_mod ); } else { my $item = $self->{mod_lists}{$path}; ### path is not catched by conditionals... ### Action : $action ### Mod item : $item ### Last item in visited paths : $self->{visited_paths}[-1] $self->visit_path( $path, '-inherit', # pass_thru '-inherit', # copied '-inherit' # ref_mod ); } ### Visit info for this path: $self->{visited_paths}[-1] $method = "open_directory" if $path eq $self->{target}; my $tran_path = $self->_translate_rel_path ($path); $method = 'open_directory' if $tran_path eq $self->{mirror}{target_path}; my $dir_baton; if ( $method eq 'open_directory' ) { my @args = @_; splice @args, 0, 2, $self->{mirror}{headrev}; $dir_baton = eval { $self->SUPER::open_directory ($tran_path, $pb, @args); }; if ( $@ ) { $dir_baton = $self->SUPER::add_directory ($tran_path, $pb, @_); } } else { $dir_baton = $self->SUPER::add_directory ($tran_path, $pb, @_); } $self->_remove_entries_in_path ($path, $dir_baton, $pool) if $do_remove_items; ++$self->{changes}; if ($crazy_replace) { # When there's a replace with history, we need to replay the # diff between the base (which we reconstruct the replace # with) and the actual new revision. The problem is that # do_update gives us only the delta between our fromrev and # current rev, which is unusable if we are reconstructing the # copy. my $item = $self->{mod_lists}{$path}; my $remote_path = $item->{remote_path}; $remote_path =~ s/%/%25/g; my $ra = $self->{mirror}->_new_ra( url => "$self->{mirror}{source_root}$remote_path" ); my $compeditor = SVN::Mirror::Ra::CompositeEditor->new ( master_editor => $self, anchor => $path, anchor_baton => $dir_baton ); $path =~ s/%/%25/g; my ($reporter) = $ra->do_diff($self->{mirror}{working}, '', 1, 1, "$self->{mirror}{source}/$path", $compeditor); my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : (); $reporter->set_path('', $item->{remote_rev}, 0, @lock); $reporter->finish_report (); $self->close_directory($dir_baton); return undef; } return $dir_baton; } sub add_file { my $self = shift; my $path = shift; my $pb = shift; my ($copypath, $copyrev) = $self->_get_copy_path_rev( $path ); ### add_file()... ### $path ### $copypath ### $copyrev return undef unless $pb; my $method = 'add_file'; my $action = $self->_in_modified_list ($path); my $crazy_replace; if ((defined $self->{mirror}{skip_to} && $self->{mirror}{skip_to} >= $self->{mirror}{working})) { ### Skiped... # no-op. add_file(). } elsif ( $action ) { ### With action: $action if ( !defined($copyrev) || $copyrev == -1) { # no-op } else { ### Come with a copy source. Use its information... ### $copypath ### $copyrev splice (@_, 0, 2, $copypath, $copyrev); } if ($action eq 'M') { ### Modify... # splice @_, 0, 2, $self->{mirror}{headrev}; $method = 'open_file'; } elsif ($action eq 'R') { ### Replace... $self->delete_entry ($path, $self->{mirror}{headrev}, $pb, $_[-1]); if ($copypath) { ++$crazy_replace; } } } elsif ( $self->is_pass_thru() ) { ### Pass thru, and not in mod list. SKip it... return; } elsif ( $self->is_copied() ) { ### path is copied from somewhere. Accept it... # no-op. } else { my $item = $self->{mod_lists}{$path}; ### path is not catched by conditionals... ### Action : $action ### Mod item : $item ### Last item in visited paths : $self->{visited_paths}[-1] } my $tran_path = $self->_translate_rel_path ($path); # Why try open_file() first then add_file() later? I saw a weird # rev which looks like: # # A /path # A /path/foo # M /path/bar # A /path/baz # # /path/bar should be A because /path is A. Anyway, to accept # this rev, falling back to add_file() if open_file() fails will # do. # # - plasma ++$self->{changes}; if ($method eq 'open_file') { my @args = @_; splice @args, 0, 2, $self->{mirror}{headrev}; my $res = eval { $self->SUPER::open_file ($tran_path, $pb, @args); }; if (!$@) { return $res } } my $file_baton = $self->SUPER::add_file ($tran_path, $pb, @_); if ($crazy_replace) { my $item = $self->{mod_lists}{$path}; my $remote_path = $item->{remote_path}; $remote_path =~ s/%/%25/g; my ($anchor, $target) = "$self->{mirror}{rsource_root}$remote_path" =~ m{(.*)/([^/]+)}; my $ra = $self->{mirror}->_new_ra( url => $anchor ); my $compeditor = SVN::Mirror::Ra::CompositeEditor->new ( master_editor => $self, anchor => $path, anchor_baton => $pb, target => $target, target_baton => $file_baton ); $path =~ s/%/%25/g; my ($reporter) = $ra->do_diff($self->{mirror}{working}, $target, 1, 1, "$self->{mirror}{rsource}/$path", $compeditor); my @lock = $SVN::Core::VERSION ge '1.2.0' ? (undef) : (); my ($tgt) = $path =~ m{([^/]+)$/}; $reporter->set_path('', $item->{remote_rev}, 0, @lock); $reporter->finish_report (); $self->close_file($file_baton, undef); # XXX: md5 return undef; } return $file_baton; } sub close_directory { my $self = shift; my $baton = shift; ### close_directory()... ### $self->{visited_paths}[-1]{path} return unless $baton; $self->leave_path(); # 'touch' the root if there's no change. $self->change_dir_prop ( $baton, 'svm' => undef ) if $baton eq $self->{root} && !$self->{changes}; $self->SUPER::close_directory ($baton, @_); } sub close_file { my $self = shift; ### close_file()... return unless $_[0]; $self->SUPER::close_file(@_); } sub delete_entry { my ($self, $path, $rev, $pb, $pool) = @_; ### delete_entry()... ### $path ### $rev return unless $pb; if ( $self->is_pass_thru() ) { my $action = $self->_in_modified_list($path) || ''; return unless $action eq 'D' || $action eq 'R'; } ++$self->{changes}; $self->SUPER::delete_entry ($path, $self->{mirror}{headrev}, $pb, $pool); } sub close_edit { my ($self, $pool) = @_; ### close_edit()... unless ($self->{root}) { # If we goes here, this must be an empty revision. We must # replicate an empty revision as well. $self->open_root ($self->{mirror}{headrev}, $pool); $self->SUPER::close_directory ($self->{root}, $pool); } delete $self->{root}; local $SIG{INT} = 'IGNORE'; local $SIG{TERM} = 'IGNORE'; $self->{mirror}->lock ('mirror'); $self->SUPER::close_edit ($pool); } package SVN::Mirror::Ra::CompositeEditor; our @ISA = ('SVN::Delta::Editor'); # XXX: this is from svk, should be merged sub AUTOLOAD { my ($self, @arg) = @_; my $func = our $AUTOLOAD; $func =~ s/^.*:://; if ($func =~ m/^(?:add|open|delete)/) { return $self->{target_baton} if defined $self->{target} && $arg[0] eq $self->{target}; $arg[0] = length $arg[0] ? "$self->{anchor}/$arg[0]" : $self->{anchor}; } elsif ($func =~ m/^close_(?:file|directory)/) { if (defined $arg[0]) { return if $arg[0] eq $self->{anchor_baton}; return if defined $self->{target_baton} && $arg[0] eq $self->{target_baton}; } } $self->{master_editor}->$func(@arg); } sub set_target_revision {} sub open_root { my ($self, $base_revision) = @_; return $self->{anchor_baton}; } sub close_edit {} 1;