munge-symlinks 1.4 KB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061
  1. #!/usr/bin/perl
  2. # This script will either prefix all symlink values with the string
  3. # "/rsyncd-munged/" or remove that prefix.
  4. use strict;
  5. use Getopt::Long;
  6. my $SYMLINK_PREFIX = '/rsyncd-munged/';
  7. my $munge_opt;
  8. &GetOptions(
  9. 'munge' => sub { $munge_opt = 1 },
  10. 'unmunge' => sub { $munge_opt = 0 },
  11. 'all' => \( my $all_opt ),
  12. 'help|h' => \( my $help_opt ),
  13. ) or &usage;
  14. &usage if $help_opt || !defined $munge_opt;
  15. my $munged_re = $all_opt ? qr/^($SYMLINK_PREFIX)+(?=.)/ : qr/^$SYMLINK_PREFIX(?=.)/;
  16. push(@ARGV, '.') unless @ARGV;
  17. open(PIPE, '-|', 'find', @ARGV, '-type', 'l') or die $!;
  18. while (<PIPE>) {
  19. chomp;
  20. my $lnk = readlink($_) or next;
  21. if ($munge_opt) {
  22. next if !$all_opt && $lnk =~ /$munged_re/;
  23. $lnk =~ s/^/$SYMLINK_PREFIX/;
  24. } else {
  25. next unless $lnk =~ s/$munged_re//;
  26. }
  27. if (!unlink($_)) {
  28. warn "Unable to unlink symlink: $_ ($!)\n";
  29. } elsif (!symlink($lnk, $_)) {
  30. warn "Unable to recreate symlink: $_ -> $lnk ($!)\n";
  31. } else {
  32. print "$_ -> $lnk\n";
  33. }
  34. }
  35. close PIPE;
  36. exit;
  37. sub usage
  38. {
  39. die <<EOT;
  40. Usage: munge-symlinks --munge|--unmunge [--all] [DIR|SYMLINK...]
  41. --munge Add the $SYMLINK_PREFIX prefix to symlinks if not already
  42. present, or always when combined with --all.
  43. --unmunge Remove one $SYMLINK_PREFIX prefix from symlinks or all
  44. such prefixes with --all.
  45. See the "munge symlinks" option in the rsyncd.conf manpage for more details.
  46. EOT
  47. }