support/munge-symlinks

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