Motivation:
URLs in E-Mails are likely to be hard-wrapped by some stupid e-mail clients, I don't know such mail-clients but our clients obviously do :) Using this small script we provide very short URLs to access our sites, and apache redirects the guests to the right place of the web-site.

This script changes and checks parameters passed via "GET" as well, to ensure a bit of safety before a dynamic-page is even hit.

Code and config etc.:

Apache VHost-Config part:

# # change the "use lib" directive in apache_rw.pl accordingly! # RewriteEngine on # RewriteMap news_map prg:/path/to/the/prog/apache_rw.pl # log to test behaviour # RewriteLog "/path/to/logs/website-rewrite.log" # RewriteLogLevel 2 # If a QUERY_STRING is required, change the * to + RewriteCond %{QUERY_STRING} ^(.*)$ # filter the query_string too RewriteRule ^(/news.*)$ ${news_map:$1?%1} [L,R] [NE]

configuration:

# creator : Tom Regner <regner@dievision.de> # created : Mon 13 Jan 2003 01:47:26 PM CET # version : $Id: apache_rw_cfg.pm,v 1.3 2003/03/07 17:33:35 tom Exp +$ # copyright : (c) 2002, www.tomsdiner.org # # config for cms_nl_ # "use"d in the rewrite-map # # package apache_rw_cfg; require Exporter; use vars qw($conf); @ISA = qw(Exporter); @EXPORT_OK = qw($conf); use strict; # # allowed parameter configurations # my $nl_params = { 'p1' => { name => 'param1', # substitute name regexp => qr/^val1$|^val2$/, # passed value /must/ match this }, 'p2' => { name => 'param1', # substitute name regexp => qr/^[a-zA-Z0-9]{16}$/, # passed value /must/ match t +his }, }; # # redirect configuration # $conf = { '/path1' => { # source url => '/real/location/of/path1', # target-url params => $nl_params, # allowed params }, '/path1/t1' => { url => '/real/location/of/somwhere/else, params => $nl_params, }, };

redirect-program (Updated Version below!):

#!/usr/bin/perl -w # creator : Tom Regner <regner@dievision.de> # created : Mon 13 Jan 2003 01:29:04 PM CET # version : $Id: apache_rw.pl,v 1.9 2003/06/12 11:10:38 tom Exp $ # copyright : (c) 2002, www.tomsdiner.org use strict; # # AFAIK no URLs whith ';'-seperated parameters are possible with this # program # # change this directive to point to the dir containing the config-file use lib '/path/to/config/file'; use apache_rw_cfg qw($conf); # necessary!! $| = 1; # unbuffered IO while (<>) { my $line = $_; if ($line =~ m{^(/[-/\w.]+?)\?([-=_&\w.]+?)(;[-\@:\w.]*)*$}) { my ($uri, $params, $remainder) = ($1, $2,$3); $remainder ||= ''; my ($new_uri, $new_params); if ($conf->{$uri}->{'url'}) { $new_uri = $conf->{$uri}->{'url'}; my $didIt = 1; my @parm_list = split(/&/, $params); $didIt = 0 if @parm_list == 0; my @new_parm_list = (); if ($didIt) { foreach (@parm_list) { my ($name,$value) = split('=', $_); if (defined($conf->{$uri}->{params}->{$name})) { if ($value =~ m{$conf->{$uri}->{params}->{$nam +e}->{regexp}}) { push(@new_parm_list, $conf->{$uri}->{param +s}->{$name}->{name} . '=' . $value); } else { $didIt = 0; } } else { $didIt = 0; } } } if ($didIt == 1) { $line = $new_uri . '?'; $remainder ||= ''; $line .= join('&', @new_parm_list) . $remainder . "\n" +; } else { $line = '/' . "\n"; } } else { $line = '/' . "\n"; } } print $line; }

regards,
tomte


Hlade's Law:

If you have a difficult task, give it to a lazy person --
they will find an easier way to do it.

Replies are listed 'Best First'.
•Re: Configurable Apache RedirectMap
by merlyn (Sage) on Jun 27, 2003 at 16:58 UTC

      merlyn++
      thanks for the URI-Tip (rant :-), I checked it and will incorporate it somtime next week, now I'm finaly of duty for the weekend and won't touch no job-code :-) (And yes, I have the permission to share snippets like these)

      It's just a program I wrote quickly the other day, but I do think it's a cool use for perl ;-)

      Update Though I just realized that the failure for ';' URIs is metioned in the comments, and the parameter split on '&' is done after the path is confirmed to be configured, the first match just splits into path and query-string (and anythong after a semicolon, on a closer look, though also the split should occur here, the handling isn't right)
      I nevertheless will incorporate the change to URI, as I find modules to be nearly always preferrable.

      regards,
      tomte


      Hlade's Law:

      If you have a difficult task, give it to a lazy person --
      they will find an easier way to do it.

Re: Configurable Apache RedirectMap (now using URI)
by Tomte (Priest) on Jul 02, 2003 at 14:10 UTC

    Here is the new version, using URI.
    However, I had difficulties to see, how the module allows me to seperate ';' seperated parts of the URI (according to o'reillys "HTTP The definitive Guide" called "parameters', opposed to the well known query-string seperated via '?'), so I strip this of with a regex before I construct the URI-Object.

    Feel free to comment on this further, I'd appriciate your feedback.

    #!/usr/bin/perl -wT # creator : Tom Regner <tomte@tomsdiner.org> # created : Mon 13 Jan 2003 01:29:04 PM CET # version : $Id: apache_rw.pl,v 1.11 2003/07/02 14:09:57 tom Exp $# +copyright : (c) 2002 use strict; use URI; # # change this directive to point to the dir containing the config-file # use lib '/path/to/config/file'; use apache_rw_cfg qw($conf); # loggen? my $DEBUG = 1; $| = 1; # unbuffered IO while (<>) { open(LOG, ">>", "apache_rw.log") if $DEBUG; # change ! my $line = $_; my ($uri, $params, $remainder); $line =~ s/(;.+)//; # strip of ';'-seperated part (session-id and +the like) $remainder = $1; my $luri = URI->new($line); $uri = $luri->path(); $params = $luri->query(); $remainder ||= ''; print LOG $uri . " || " . $remainder . " || " . $params . "\n" if + $DEBUG; my ($new_uri, $new_params); if ($conf->{$uri}->{'url'}) { $new_uri = $conf->{$uri}->{'url'}; my $didIt = 1; my @parm_list = split(/&/, $params); $didIt = 0 if @parm_list == 0; my @new_parm_list = (); if ($didIt) { foreach (@parm_list) { my ($name,$value) = split('=', $_); if (defined($conf->{$uri}->{params}->{$name})) { if ($value =~ m{$conf->{$uri}->{params}->{$name}-> +{regexp}}) { push(@new_parm_list, $conf->{$uri}->{params}-> +{$name}->{name} . '=' . $value); } else { $didIt = 0; print LOG "Param-Value violation" if $DEBUG; } } else { $didIt = 0; print LOG "Param-Name violation" if $DEBUG; } } } if ($didIt == 1) { $line = $new_uri . '?'; $remainder ||= ''; $line .= join('&', @new_parm_list) . $remainder . "\n"; } else { $line = '/' . "\n"; } } else { $line = '/' . "\n"; } close(LOG) if $DEBUG; $line = URI->new($line)->canonical; print $line; } #

    regards,
    tomte


    Hlade's Law:

    If you have a difficult task, give it to a lazy person --
    they will find an easier way to do it.