]>
git.ipfire.org Git - thirdparty/squid.git/blob - contrib/url-normalizer.pl
182cbcbd4ea000f3d4582891d145200642d94a2a
1 #!/usr/local/bin/perl -Tw
3 # * Copyright (C) 1996-2020 The Squid Software Foundation and contributors
5 # * Squid software is distributed under GPLv2+ license and includes
6 # * contributions from numerous individuals and organizations.
7 # * Please see the COPYING and CONTRIBUTORS files for details.
10 # From: Markus Gyger <mgyger@itr.ch>
12 # I'd like to see a redirector which "normalizes" URLs to have
13 # a higher chance to get a hit. I didn't see such a redirector,
14 # so I thought I would send my little attempt. However, I have
15 # no real idea how much CPU time it needs using the LWP modules,
16 # but it seems to work.
22 $| = 1; # force a flush after every print on STDOUT
24 my ($url, $addr, $fqdn, $ident, $method);
27 ($url, $addr, $fqdn, $ident, $method) = m
:(\S
*) (\S
*)/(\S
*) (\S
*) (\S
*):;
30 $url = url
$url; # also removes default port number
31 $url->host(lc $url->host); # map host name to lower case
32 my $epath = $url->epath;
33 $epath =~ s/%7e/~/ig; # unescape ~
34 $epath =~ s/(%[\da-f]{2})/\U$1/ig; # capitalize escape digits
35 if ($url->scheme =~ /^(http|ftp)$/) {
36 $epath =~ s
:/\./:/:g
; # safe?
37 $epath =~ s
://:/:g
; # safe?
46 print "$url $addr/$fqdn $ident $method\n"
51 unless (URI
::URL
::implementor
('cache_object')) {
53 @cache_object::ISA
= (URI
::URL
::implementor
());
54 URI
::URL
::implementor
('cache_object', 'cache_object');
56 sub default_port
{ 3128 }