Attachment 'srv-redir.pl'
Download 1 #!/usr/bin/perl
2 #
3 # Author and (C): Francesco Chemolli <kinkie@squid-cache.org>
4 #
5 # This redirector implement a working proof-of-concept for using
6 # DNS "SRV" type records to locate origin servers.
7 #
8 # For specifications see:
9 # http://www.ietf.org/rfc/rfc2782.txt
10 # http://www.anta.net/nic/draft-andrews-http-srv-01.shtml
11 #
12 #
13 #
14 # This program is free software; you can redistribute it and/or modify
15 # it under the terms of the GNU General Public License as published by
16 # the Free Software Foundation; either version 2 of the License, or
17 # (at your option) any later version.
18 #
19 # This program is distributed in the hope that it will be useful,
20 # but WITHOUT ANY WARRANTY; without even the implied warranty of
21 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22 # GNU General Public License for more details.
23 #
24 # You should have received a copy of the GNU General Public License
25 # along with this program; if not, write to the Free Software
26 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
27
28 ########## TUNEABLES ###########
29 my $negative_cache_ttl=60; #seconds
30 my $debug_enabled=0;
31
32 ######## TUNEABLES END #########
33 my %negative_cache; #format: hostname -> expiry_timestamp
34 my %positive_cache; #format: hostname -> { "exp" => expiry_timestamp }
35
36
37 $|=1;
38 use URI::URL;
39 use Net::DNS;
40 use Data::Dumper;
41
42 my $res=Net::DNS::Resolver->new;
43
44 my ($url, $addr, $fqdn, $ident, $method);
45 while (<>) {
46 chomp;
47 dbg ("got string '$_'");
48 ($url, $addr, $fqdn, $ident, $method,$extra) = m:(\S*) (\S*)/(\S*) (\S*) (\S*) ?(.*):;
49
50 # only apply to HTTP, it's a POC after all
51 unless ($url =~ m!^http://!) {
52 dbg("url '$url' is not http.Skipping");
53 print "\n";
54 next;
55 }
56 #normalize URL
57 $url = url $url; # also removes default port number
58 unless (defined $url) {
59 dbg("couldn't parse url. Skipping");
60 print "\n";
61 next;
62 }
63
64 #TODO: handle the case of nonstandard ports as per specs.
65 $host=lc ($url->host);
66 dbg ("got host $host");
67
68 #TODO: every once in a while sweep the cache to get rid of junk
69 #TODO: use shared memory for the cache?
70 if (exists $negative_cache{$host} && $negative_cache{$host} > time) {
71 dbg ("negative cache hit");
72 print "\n";
73 next;
74 }
75 #TODO: add positive caching logic
76 my $query=$res->query("_http._tcp.$host","SRV");
77
78 unless (defined $query) { #no srv-record. return.
79 $negative_cache{$host}=time+$negative_cache_ttl;
80 print "\n";
81 next;
82 }
83
84 my @records=Net::DNS::rrsort("SRV","priority",$query->answer);
85 dbg("records: ".Dumper(@records));
86 if ($#records == -1) { #empty result-set. return
87 print "\n";
88 next;
89 }
90
91 #TODO: use more sophisticated logic:
92 # load-balancing + session affinity + availability monitoring
93
94 $newhost=$records[0]->target;
95 $newport=$records[0]->port;
96
97 $url->host(lc $newhost);
98 $url->port($newport);
99
100 dbg ("sending $url");
101 print $url."\n"; #host found. redirect.
102 }
103
104
105 sub dbg {
106 return unless $debug_enabled;
107 print STDERR "dns-redir[$$]: ",$_[0],"\n";
108 }
Attached Files
To refer to attachments on a page, use attachment:filename, as shown below in the list of files. Do NOT use the URL of the [get] link, since this is subject to change and can break easily.You are not allowed to attach a file to this page.