tools/url-pattern-translator.pl

   1 #!/usr/bin/perl
   2
   3 ############################################################################
   4 #
   5 # url-pattern-translator
   6 #
   7 # Filters Privoxy action files and changes old-school URL patterns to
   8 # use extended regular expressions for the host as well.
   9 #
  10 # While it works good enough to satisfy the regression tests in
  11 # default.action.master, it isn't perfect and you should double-check
  12 # the output and keep backups of your old action files.
  13 #
  14 # Usage:
  15 #
  16 # url-pattern-translator.pl old.action > new.action
  17 #
  18 # Only convert your files once, or, as RoboCop used to say,
  19 # there will be... trouble.
  20 #
  21 # Copyright (c) 2008 Fabian Keil <fk@fabiankeil.de>
  22 #
  23 # Permission to use, copy, modify, and distribute this software for any
  24 # purpose with or without fee is hereby granted, provided that the above
  25 # copyright notice and this permission notice appear in all copies.
  26 #
  27 # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
  28 # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
  29 # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
  30 # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
  31 # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
  32 # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  33 # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  34 #
  35 ############################################################################
  36
  37 use strict;
  38 use warnings;
  39
  40 sub p ($) {
  41     my $message = shift;
  42     print $message . "\n";
  43 }
  44
  45 sub convert_host_pattern ($) {
  46     my $host_pattern = shift;
  47     my $hp = $host_pattern;
  48
  49     $hp =~ s@\s@@g;
  50
  51     if ($hp =~ m@^\.@) {
  52         # Not left-anchored
  53         #
  54         # XXX: This is somewhat ugly and while it's
  55         # the equivalent pattern in most cases
  56         # \. should be good enough.
  57         $hp =~ s@^\.@(^|.)@;
  58     } else {
  59         # left-anchored
  60         $hp = '^' . $hp;
  61     }
  62
  63     # Match-all syntax has changed ...
  64     $hp =~ s@\*@[^.]*@g;
  65
  66     # Extended host patterns are right-anchored by default
  67     $hp =~ s@\.$@(\..*)?@;
  68
  69     # Literal dots have to be escaped
  70     $hp =~ s@((?<!\\)\.[^*])@\\$1@g;
  71
  72     # Match single character with a dot.
  73     $hp =~ s@(?<!\))\?@.@g;
  74
  75     # Add the prefix
  76     $hp = "PCRE-HOST-PATTERN:" . $hp;
  77
  78     return $hp;
  79 }
  80
  81 sub looks_interesting($) {
  82     my $line = shift;
  83     my $type_to_skip = undef;
  84
  85     if (/^\s*\#/) {
  86
  87         $type_to_skip = "comment";
  88
  89     } elsif (/[{}]/ or /\\$/) {
  90
  91         $type_to_skip = "action settings";
  92
  93     } elsif (m@^\s*$@) {
  94
  95         $type_to_skip = "whitespace";
  96
  97     } elsif (m@^\s*TAG:@) {
  98
  99         $type_to_skip = "tag patttern";
 100
 101     } elsif (m@^[^/]*=@) {
 102
 103         $type_to_skip = "macro or version definition";
 104
 105     } elsif (m@^\s*standard\.@) {
 106
 107         $type_to_skip = "predefined settings";
 108
 109     }
 110
 111     #p("Skipping " . $type_to_skip . ": " . $_) if defined $type_to_skip;
 112
 113     return not defined $type_to_skip;
 114 }
 115
 116 sub main () {
 117     my $host = undef;
 118     my $path = undef;
 119
 120     while (<>) {
 121         chomp;
 122
 123         if (looks_interesting($_)) {
 124             if (m@^([^/]+)(/.*)$@) {
 125                 $host = $1;
 126                 $path = $2;
 127                 $host = convert_host_pattern($host);
 128                 $_ = $host . $path;
 129             }
 130             elsif (m@^([^/]*)$@) {
 131                 $host = $1;
 132                 $host = convert_host_pattern($host);
 133                 $_ = $host;
 134             }
 135         }
 136         p($_);
 137     }
 138 }
 139
 140 main();