support/cull_options

   1 #!/usr/bin/perl
   2 # This script outputs some perl code that parses all possible options
   3 # that the code in options.c might send to the server.  This perl code
   4 # is included in the rrsync script.
   5 use strict;
   6 no strict 'refs';
   7
   8 our(%short_no_arg, %short_with_num);
   9 our(%long_no_arg, %long_before_arg, %long_with_arg);
  10 our $last_long_opt;
  11
  12 open(IN, '../options.c') or die "Unable to open ../options.c: $!\n";
  13
  14 while (<IN>) {
  15     if (/\Qargstr[x++]\E = '(.)'/) {
  16         $short_no_arg{$1} = 1;
  17         undef $last_long_opt;
  18     } elsif (/\Qasprintf(\E[^,]+, "-([a-zA-Z0-9])\%l?[ud]"/) {
  19         $short_with_num{$1} = 1;
  20         undef $last_long_opt;
  21     } elsif (/\Qargs[ac++]\E = "--([^"=]+)"/) {
  22         $last_long_opt = $1;
  23         $long_no_arg{$1} = 1;
  24     } elsif (defined($last_long_opt)
  25         && /\Qargs[ac++]\E = ([^["\s]+);/ && $1 ne 'dest_option') {
  26         delete $long_no_arg{$last_long_opt};
  27         $long_before_arg{$last_long_opt} = 1;
  28         undef $last_long_opt;
  29     } elsif (/dest_option = "--([^"])"/) {
  30         $long_before_arg{$1} = 1;
  31         undef $last_long_opt;
  32     } elsif (/\Qasprintf(\E[^,]+, "--([^"=]+)=/ || /\Qargs[ac++]\E = "--([^"=]+)=/) {
  33         $long_with_arg{$1} = 1;
  34         undef $last_long_opt;
  35     }
  36 }
  37 close IN;
  38
  39 my $short_no_arg = join('', sort keys %short_no_arg);
  40 my $short_with_num = join('', sort keys %short_with_num);
  41
  42 print <<EOT;
  43
  44 # These options are the only options that rsync might send to the server,
  45 # and only in the option/arg format that the stock rsync produces.
  46
  47 # To disable a short-named option, add its letter to this string:
  48 our \$short_disabled = '';
  49
  50 our \$short_no_arg = '$short_no_arg'; # DO NOT REMOVE ANY
  51 our \$short_with_num = '$short_with_num'; # DO NOT REMOVE ANY
  52
  53 # To disable a long-named option, change its value to a 0 (NOTE: at least
  54 # one option appears in two places!).  A value of -1 means the arg doesn't
  55 # need checking, a 1 means to check it, a 2 means only check when receiving.
  56 EOT
  57
  58 foreach my $name (qw( long_no_arg long_with_arg long_before_arg )) {
  59     $_ = "our \%$name = (\n  '" . join("' => 1,\n  '", sort keys %$name) . "' => 1,\n);\n";
  60     if ($name eq 'long_before_arg') {
  61         s/ 1,/ 2,/g;
  62         s/('files-from' =>) 2,/$1 1,/;
  63         s/('max-.* =>) 2,/$1 -1,/g;
  64     } else {
  65         s/ 1,/ -1,/g;
  66         s/('files-from' =>) -1,/$1 1,/;
  67     }
  68     s/('remove-.* =>) (-?\d),/$1 \$ro ? 0 : $2,/g;
  69     print;
  70 }
  71
  72 print "\n";