#!/usr/bin/perl
# License: Public Domain or CC0
# See https://creativecommons.org/publicdomain/zero/1.0/
# The author, Jim Avera (jim.avera at gmail) has waived all copyright and
# related or neighboring rights to the content of this file.
# Attribution is requested but is not required.
use strict; use warnings FATAL => 'all';
use feature qw(state say current_sub signatures);
use version 0.77; our $VERSION = version->declare(sprintf "v%s", q$Id: safe_rsync,v 1.11 2026/06/24 19:35:23 jima Exp jima $ =~ /(\d[.\d]+)/);
use utf8; { use open ':std', IO => ':encoding(UTF-8)'; }
STDOUT->autoflush(); STDERR->autoflush();

sub USAGE() {
  return (<<'EOF' . "VERSION = $VERSION\n");

safe_rsync [OPTIONS] [RSYNC-OPTIONS] SOURCES...  DESTDIR/

Relative symlinks can be freely used in local SOURCES including links pointing 
outside of SOURCES; symlinks will be preserved in the destiantion where possible 
(i.e. when they point within the transfer) but otherwise converted into copies.

OPTIONS:

  -V or --Verbose to see the generated rsync commands
  -Debug          to see internal trace messages

  (silent by default)

This wrapper works around a problem with rsync --copy-unsafe-links where the
result can nevertheless contain wrong or broken symlinks.  For example, given this:

 /tmp/tdir
 ├── distant
 │   ├── file1.txt
 │   └── foodir
 │       └── link_to_file1.txt -> ../file1.txt
 └── src
     └── a
         └── b
             └── link_to_foodir -> /tmp/tdir/distant/foodir

rsync -r -l --copy-unsafe-links /tmp/tdir/src/a/ /tmp/tdir/dst/a/
produces this:

 /tmp/tdir/dst
 └── a
     └── b
         └── link_to_foodir
             └── link_to_file1.txt -> ../file1.txt  # BROKEN LINK

The "bug" is that rsync thinks 'link_to_file1.txt' is safe because it points up 
only one level and it will exist three levels down in the implied result tree;
however since it is included only via a link to "foodir", even a single-level uplink
e.g '../file1.txt' refers to something which will not exist in the transfer,
rendering the result unusable (to rsync "safe" only means a link can not point 
outside the *result* tree and so can not access possibly-sensitve data;
not that a link is safe from beciming broken when copied to the destination.)

HOW IT WORKS

This wrapper pre-scans the inputs (which must be local) to find symlinks rsync 
will wrongly treat as "safe"; an exclude list is built and used in an initial 
rsync run with --copy-unsafe-links to transfer everything else including symlinks
which do refer within the transfer; then a second rsync run is done to transfer 
just the problem items using --copy-links (which forces copying as real files/dirs
and not as symlinks).

EOF
}

use Getopt::Long qw(GetOptions);
use Path::Tiny qw/path/;
use File::Find ();
use Guard qw/scope_guard/;
use Data::Dumper::Interp qw/:DEFAULT dvisO/;
visnew
  ->Sortkeys(sub ($h) {
    my %haskey = (map{ $_ => 1 } keys %$h);
    my @keys;
    #for my $k(qw/src dst excludes sub_rsyncs/) {
    #  push @keys, $k if delete $haskey{$k};
    #}
    return [@keys, sort keys %haskey];
  })
#  ->Refaddr(1)
  ->set_defaults;
use Cwd qw/getcwd abs_path/;
use Spreadsheet::Edit::Log qw/:btw oops/;


sub _regen_getopt_code() {
  my %namelists;
  foreach (qx/man rsync/) {
    pos=0;
    last if /run.*daemon.*the following.*are.*accept/;
    if (/^\h*(?=-)/gc) {
      my (@names, $hasarg);
      while (/\G(?:--?)([a-zA-Z0][-a-zA-Z0]*)/gc) {
        last if $1 eq "no-OPTION";
        last if $1 eq "help";
        next if $1 eq "V";  # still handle --verbose
        push @names, $1;
        if (/\G=/gc) { $hasarg = 1; }
        last unless /\G\S*,\h*/gc;
      }
      next unless @names > 0;
      foreach my $n (@names) { $namelists{$n} = "IGN"; }
      # Always put the long name first, which is the canonical name used
      # as a key in %rsync_opts
      my $namelist = join('|', sort { length($b) <=> length($a) } @names);
      $namelists{$namelist} = $hasarg // 0;
    }
  }
  print "    # Generated by $0 --regen ",scalar(localtime),"\n";
  for my $namelist (sort keys %namelists) {
    my $hasarg = $namelists{$namelist};
    next if $hasarg eq "IGN";
    my $lhs = vis( 
        $namelist . ($hasarg ? "=s" 
                             : $namelist =~ /^no-/ ? "" : "!") );
    # The "!" makes Getopt::Long recognize --noXXX args.
    # Unfortunately rsync uses a different convention: --no-XXX
    # This is handled by a pre-scan of ARGV
    my $rhs = $hasarg ? "\\&_save_rsync_argopt" : "\\&_save_rsync_boolopt";
    printf "    %-22s => %s,\n", $lhs, $rhs;
  }
  print "    # (End generated specs)\n";
}

sub cleaned :prototype(_) ($path) {  # rm dup slashes, trailing slash
  return path($path)->canonpath;
}

my ($Debug, $Verbose, $Colorize, @rsync_opts, %rsync_opts);
$Colorize = 1;

my $tmp_file; # Path::Tint tempfile, deleted when last ref is gone


sub _save_rsync_boolopt($argname, $val, @rest) {
  $rsync_opts{$argname} = $val;
  if ($val) {
    push @rsync_opts, (length($argname)==1 ? "-" : "--").$argname;
  } else {
    # @rsync_opts = grep{ ! /^--?${argname}$/ } @rsync_opts;
    push @rsync_opts, "--no-".$argname;
  }
}
sub _save_rsync_argopt($argname, $val, @rest) {
  # The hash is only for our checks, concatenating values if multiple
  ($rsync_opts{$argname}//="") .= $val;
  # But each instance is passed through to rsync
  push @rsync_opts, (length($argname)==1 ? "-" : "--").$argname;
  push @rsync_opts, $val;
}

sub rev_sort :prototype(&\@) ($cmp, $aref) {
  $cmp ? (sort { -1 * ($cmp->()) } @$aref)
       : (sort { $b cmp $a } @$aref)
}

# * * * * * MAIN * * * * * *

# pre-convert rsync arg forms not handled by our generated code
foreach (@ARGV) {
  s/^--no-ic\w*$/--iconv=-/;
}

Getopt::Long::Configure qw(gnu_getopt no_ignore_case);
GetOptions(
  "Colorize!"         => \$Colorize,
  "Debug"             => \$Debug,  # to not clash with rsync's --debug
  "Tmpfile=s"         => sub{ $tmp_file = path($_[1]) },
  "V|Verbose"         => \$Verbose,
  "help"              => sub{ print USAGE; exit 0; },
  "regen-getopt-code" => sub{ _regen_getopt_code; exit; },
    # Generated by /home/jima/bin/safe_rsync --regen Wed Jun 24 12:31:07 2026
    "D!"                   => \&_save_rsync_boolopt,
    "F!"                   => \&_save_rsync_boolopt,
    "P!"                   => \&_save_rsync_boolopt,
    "acls|A!"              => \&_save_rsync_boolopt,
    "address=s"            => \&_save_rsync_argopt,
    "append!"              => \&_save_rsync_boolopt,
    "append-verify!"       => \&_save_rsync_boolopt,
    "archive|a!"           => \&_save_rsync_boolopt,
    "atimes|U!"            => \&_save_rsync_boolopt,
    "backup-dir=s"         => \&_save_rsync_argopt,
    "backup|b!"            => \&_save_rsync_boolopt,
    "block-size|B=s"       => \&_save_rsync_argopt,
    "blocking-io!"         => \&_save_rsync_boolopt,
    "bwlimit=s"            => \&_save_rsync_argopt,
    "checksum-choice=s"    => \&_save_rsync_argopt,
    "checksum-seed=s"      => \&_save_rsync_argopt,
    "checksum|c!"          => \&_save_rsync_boolopt,
    "chmod=s"              => \&_save_rsync_argopt,
    "chown=s"              => \&_save_rsync_argopt,
    "compare-dest=s"       => \&_save_rsync_argopt,
    "compress-choice=s"    => \&_save_rsync_argopt,
    "compress-level=s"     => \&_save_rsync_argopt,
    "compress|z!"          => \&_save_rsync_boolopt,
    "contimeout=s"         => \&_save_rsync_argopt,
    "copy-as=s"            => \&_save_rsync_argopt,
    "copy-dest=s"          => \&_save_rsync_argopt,
    "copy-devices!"        => \&_save_rsync_boolopt,
    "copy-dirlinks|k!"     => \&_save_rsync_boolopt,
    "copy-links|L!"        => \&_save_rsync_boolopt,
    "copy-unsafe-links!"   => \&_save_rsync_boolopt,
    "crtimes|N!"           => \&_save_rsync_boolopt,
    "cvs-exclude|C!"       => \&_save_rsync_boolopt,
    "debug=s"              => \&_save_rsync_argopt,
    "del!"                 => \&_save_rsync_boolopt,
    "delay-updates!"       => \&_save_rsync_boolopt,
    "delete!"              => \&_save_rsync_boolopt,
    "delete-after!"        => \&_save_rsync_boolopt,
    "delete-before!"       => \&_save_rsync_boolopt,
    "delete-delay!"        => \&_save_rsync_boolopt,
    "delete-during!"       => \&_save_rsync_boolopt,
    "delete-excluded!"     => \&_save_rsync_boolopt,
    "delete-missing-args!" => \&_save_rsync_boolopt,
    "devices!"             => \&_save_rsync_boolopt,
    "dirs|d!"              => \&_save_rsync_boolopt,
    "dry-run|n!"           => \&_save_rsync_boolopt,
    "early-input=s"        => \&_save_rsync_argopt,
    "exclude=s"            => \&_save_rsync_argopt,
    "exclude-from=s"       => \&_save_rsync_argopt,
    "executability|E!"     => \&_save_rsync_boolopt,
    "existing!"            => \&_save_rsync_boolopt,
    "fake-super!"          => \&_save_rsync_boolopt,
    "files-from=s"         => \&_save_rsync_argopt,
    "filter|f=s"           => \&_save_rsync_argopt,
    "force!"               => \&_save_rsync_boolopt,
    "from0|0!"             => \&_save_rsync_boolopt,
    "fsync!"               => \&_save_rsync_boolopt,
    "fuzzy|y!"             => \&_save_rsync_boolopt,
    "groupmap=s"           => \&_save_rsync_argopt,
    "group|g!"             => \&_save_rsync_boolopt,
    "hard-links|H!"        => \&_save_rsync_boolopt,
    "human-readable|h!"    => \&_save_rsync_boolopt,
    "iconv=s"              => \&_save_rsync_argopt,
    "ignore-errors!"       => \&_save_rsync_boolopt,
    "ignore-existing!"     => \&_save_rsync_boolopt,
    "ignore-missing-args!" => \&_save_rsync_boolopt,
    "ignore-times|I!"      => \&_save_rsync_boolopt,
    "include=s"            => \&_save_rsync_argopt,
    "include-from=s"       => \&_save_rsync_argopt,
    "info=s"               => \&_save_rsync_argopt,
    "inplace!"             => \&_save_rsync_boolopt,
    "ipv!"                 => \&_save_rsync_boolopt,
    "itemize-changes|i!"   => \&_save_rsync_boolopt,
    "keep-dirlinks|K!"     => \&_save_rsync_boolopt,
    "link-dest=s"          => \&_save_rsync_argopt,
    "links|l!"             => \&_save_rsync_boolopt,
    "list-only!"           => \&_save_rsync_boolopt,
    "log-file=s"           => \&_save_rsync_argopt,
    "log-file-format=s"    => \&_save_rsync_argopt,
    "max-alloc=s"          => \&_save_rsync_argopt,
    "max-delete=s"         => \&_save_rsync_argopt,
    "max-size=s"           => \&_save_rsync_argopt,
    "min-size=s"           => \&_save_rsync_argopt,
    "mkpath!"              => \&_save_rsync_boolopt,
    "modify-window=s"      => \&_save_rsync_argopt,
    "munge-links!"         => \&_save_rsync_boolopt,
    "no-implied-dirs"      => \&_save_rsync_boolopt,
    "no-motd"              => \&_save_rsync_boolopt,
    "numeric-ids!"         => \&_save_rsync_boolopt,
    "old-args!"            => \&_save_rsync_boolopt,
    "old-dirs|old-d!"      => \&_save_rsync_boolopt,
    "omit-dir-times|O!"    => \&_save_rsync_boolopt,
    "omit-link-times|J!"   => \&_save_rsync_boolopt,
    "one-file-system|x!"   => \&_save_rsync_boolopt,
    "only-write-batch=s"   => \&_save_rsync_argopt,
    "open-noatime!"        => \&_save_rsync_boolopt,
    "out-format=s"         => \&_save_rsync_argopt,
    "outbuf=s"             => \&_save_rsync_argopt,
    "owner|o!"             => \&_save_rsync_boolopt,
    "partial!"             => \&_save_rsync_boolopt,
    "partial-dir=s"        => \&_save_rsync_argopt,
    "password-file=s"      => \&_save_rsync_argopt,
    "perms|p!"             => \&_save_rsync_boolopt,
    "port=s"               => \&_save_rsync_argopt,
    "preallocate!"         => \&_save_rsync_boolopt,
    "progress!"            => \&_save_rsync_boolopt,
    "protocol=s"           => \&_save_rsync_argopt,
    "prune-empty-dirs|m!"  => \&_save_rsync_boolopt,
    "quiet|q!"             => \&_save_rsync_boolopt,
    "read-batch=s"         => \&_save_rsync_argopt,
    "recursive|r!"         => \&_save_rsync_boolopt,
    "relative|R!"          => \&_save_rsync_boolopt,
    "remote-option|M=s"    => \&_save_rsync_argopt,
    "remove-source-files!" => \&_save_rsync_boolopt,
    "rsh|e=s"              => \&_save_rsync_argopt,
    "rsync-path=s"         => \&_save_rsync_argopt,
    "safe-links!"          => \&_save_rsync_boolopt,
    "secluded-args|s!"     => \&_save_rsync_boolopt,
    "size-only!"           => \&_save_rsync_boolopt,
    "skip-compress=s"      => \&_save_rsync_argopt,
    "sockopts=s"           => \&_save_rsync_argopt,
    "sparse|S!"            => \&_save_rsync_boolopt,
    "specials!"            => \&_save_rsync_boolopt,
    "stats!"               => \&_save_rsync_boolopt,
    "stderr=s"             => \&_save_rsync_argopt,
    "stop-after=s"         => \&_save_rsync_argopt,
    "stop-at=s"            => \&_save_rsync_argopt,
    "suffix=s"             => \&_save_rsync_argopt,
    "super!"               => \&_save_rsync_boolopt,
    "temp-dir|T=s"         => \&_save_rsync_argopt,
    "timeout=s"            => \&_save_rsync_argopt,
    "times|t!"             => \&_save_rsync_boolopt,
    "trust-sender!"        => \&_save_rsync_boolopt,
    "update|u!"            => \&_save_rsync_boolopt,
    "usermap=s"            => \&_save_rsync_argopt,
    "verbose|v!"           => \&_save_rsync_boolopt,
    "version!"             => \&_save_rsync_boolopt,
    "whole-file|W!"        => \&_save_rsync_boolopt,
    "write-batch=s"        => \&_save_rsync_argopt,
    "write-devices!"       => \&_save_rsync_boolopt,
    "xattrs|X!"            => \&_save_rsync_boolopt,
    # (End generated specs)
) or die "died";

my $tree_cmd = "tree -F";
if (!$Colorize) { $ENV{NO_COLOR} = 1; } # for btw
else { $tree_cmd .= " -C"; }

if ($rsync_opts{version}) {
  say "\n$0 version $VERSION;  License: Public Domain or CC0.";
  say "\n> rsync --version";
  system("rsync", "--version");
  exit 0;
}

die USAGE if @ARGV < 2 && !$Debug;
my $top_dst = pop @ARGV;
my @top_srcs = @ARGV;

# Rsync allows renaming a single file or empty directory by specifying a
# non-existent destination path without a trailing slash.  
# We don't handle that.
die "DESTDIR must have a trailing slash (not ${\visq($top_dst)})\n"
  unless $top_dst =~ /\/$/;

if ($Debug || $rsync_opts{debug}) {
  unshift @rsync_opts, "-i" unless $rsync_opts{'itemize-changes'};
  unshift @rsync_opts, "--debug=FILTER" unless ($rsync_opts{'debug'}//"") =~ /FILTER/;
} else {
  unless ($rsync_opts{recursive} or $rsync_opts{archive}) {
    die "Using $0 is pointless without -r or -a\n"
  }
}
for my $argname (qw/links copy-unsafe-links/) {
  if (defined (my $val = $rsync_opts{$argname})) {
    die "Using $0 is pointless with --no-$argname" if !$val;
  } else {
    push @rsync_opts, "--$argname";
  }
}

$Verbose = 1
  if $Debug || $rsync_opts{verbose} || $rsync_opts{'itemize-changes'};


######################################################################

sub process_a_src($top_src) {
  my @excluded_links;
  my %devino_seen;
  my $cleaned_top_src = cleaned( $top_src );
  # In rsync args:
  # SRCDIR/ means copy the contents (but not SRCDIR itself) into DESTDIR/ ;
  # [anything/]SRCDIR means copy the directory into DESTDIR/SRCDIR except
  # if SRCDIR is . or .. (and hence not named) then it is treated as if there
  # were a trailing slash i.e. it's contents are copied directly into DESTDIR/.
  #
  # For us, DESTDIR/ always has a trailing slash (we don't handle the special
  # rsync mode to rename a single object where DEST is without a slash).
  my $topsrc_is_included = 
    $top_src !~ /\/$/ && path($cleaned_top_src)->basename !~ /^\.\.?$/;
  my $top2 = $topsrc_is_included ? path($cleaned_top_src)->parent."/" : $cleaned_top_src."/";
  # $parentslash must be the first part of every path(...)->children
  # and child paths will include the parent unless the parent is ".".
  ##my $parentslash = $cleaned_top_src eq "." ? "" : $top2;
  my $parentslash = $top2 eq "./" ? "" : $top2;
  my @stack = ([$top_src, $topsrc_is_included ? 0 : -1]);
  warn dvis '### $top_src  $topsrc_is_included   $parentslash  $top2\n' if $Debug;
  while (@stack) {
    my ($p, $max_uplinks) = @{ pop(@stack) };
    warn btwpad,"visiting -",
         (-l $p ? "l":""), (-d $p ? "d":""), (-f $p ? "f":""),
         " $p [$max_uplinks]\n",
         btwpad,dvisO '@stack\n'  if $Debug;

    my $lstat = path($p)->lstat;
    my $isdir;
    if (-l $lstat) {
      my $rawlnk = readlink($p) // die $!;
      my $clnk = cleaned( $rawlnk ); # remove extraneous slashes
      if ($clnk !~ /^\//) { # relative
        my $skip = 1;
        my $nup = 0;
        foreach (split m{/}, $clnk) {
          if ($_ eq "..") { $skip=0,last if ++$nup > $max_uplinks } else { --$nup }
        }
        warn btwpad, "  : RELATIVE symlink ($p -> $clnk): ", dvis '$skip\n' if $Debug;
        if ($skip) {
          # relative symlink safely points within it's subtree
          next;
        }
        warn btwpad, "  : EXCLUDING $p\n" if $Debug;
        push @excluded_links, $p;
      }
      $isdir = (-d $p);  # stat, not lstat (follows symlinks)
      warn btwpad, "  : symlink ($p): ", dvis '$isdir\n' if $Debug;
      if ($isdir) {
         # symlink to directory
         if ($devino_seen{ $lstat->dev ."|". $lstat->ino }++) {
           #die "Reached DIR symlink ",qsh($p)," a second time";  #TODO silently ignore?
           warn btwpad, "  : Skipping 2nd visitation of DIR symlink $p\n" if $Debug;
           next;
         }
         $max_uplinks = -1;  # incremented below
      }
    } else {
      $isdir = (-d $lstat);
      warn btwpad, "  : NOT symlink ($p): ", dvis '$isdir\n' if $Debug;
    }
    if ($isdir) {
      # Visit children in alphabetical order.  Can't use Path::Tiny because we
      # need to preserve the original top_src including leading ./ if present
      # WRONG...?
      my @child_paths =  path($p)->children;
      push @stack, map{ [$_, $max_uplinks+1] }
                   reverse sort @child_paths;
    }
  }

  btw dvisO '@excluded_links' if $Debug;

  my @excl_opts;
  if (@excluded_links) {
    $tmp_file //= Path::Tiny->tempfile; # deleted when $tmp_file is destroyed
    my @lines = map{
                     m{^\Q${parentslash}\E(.*)} or die dvis 'BUG ${parentslash}\n    $_';
                     "/$1\n"
                } @excluded_links;
    $tmp_file->spew_raw(@lines);
    print "> exclude-from file contains ",scalar(@lines)," entries\n"
      if $Verbose;
    print map{ "   $_" } @lines if $Debug;
    @excl_opts = ("--exclude-from", $tmp_file);
  }

  # *FIRST RSYNC* copies everything except unsafe symlinks
  { # N.B. --exclude-from must go before user options which might use --include
    my @cmd = ('rsync', @excl_opts, @rsync_opts, $top_src, $top_dst);
    warn "> ",qshlist(@cmd), "\n" if $Verbose;
    system(@cmd) == 0 or die "rsync failed";
  }

  if (@excluded_links) {
    # *SECOND RSYNC* copies only the previously-excluded unsafe symlinks (as files).
    # --files-from is used to copy only the explicitly listed items;
    #
    # The "src" will be the parent of the transfer root for the main rsync ($top2)
    @excl_opts = ("--files-from", $tmp_file, "--recursive");
    @rsync_opts = grep{ !/^--(exclude-unsafe-links|copy-dirlinks)/ }  @rsync_opts;
    my @cmd = ('rsync', @excl_opts, @rsync_opts, "--copy-links", $top2, $top_dst);
    warn "> ",qshlist(@cmd), "\n" if $Verbose;
    system(@cmd) == 0 or die "rsync failed";
  }

  if ($Debug && $top_dst !~ /^[-.\w]*:/ && ! $rsync_opts{'dry-run'}) {
    system "set -x; $tree_cmd ".qsh(cleaned $top_dst);
  }

}#process_a_src

foreach (@top_srcs) {
  /:/ && die "Sorry, ${\(path($0)->basename)} can only work with local sources.\n";
  process_a_src($_);
}