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