Listing 2. The Proxy Redirector<remark role="output-file">11774l2.qrk</remark>

<title>Listing 2. The Proxy Redirector<remark
role="output-file">11774l2.qrk</remark></title>


<programlisting>
 1  #!/usr/bin/perl
 2
 3  use DBI;
 4
 5  $blocked = "http://192.168.1.10/blocked.html";
 6
 7  my $dbh = DBI->connect("dbi:mysql:authentication:host=192.168.1.10", "user", "password") || die("Can\'t connect to database.\n");
 8
 9  $|=1;
10
11  while (<STDIN>) {
12          my($sth, $r, $c);
13          my($url, $client, $d, $method, $proxy_ip, $proxy_port);
14
15          chomp($r = $_);
16
17          if ($r !~ m/\S+/) { next; }
18
19          ($url, $client, $d, $method, $proxy_ip, $proxy_port) = split(/\s/, $r);
20
21          $client =~ s/\/-//;
22          $proxy_ip =~ s/myip=//;
23          $proxy_port =~ s/myport=//;
24
25          $sth = $dbh->prepare("select * from web_clients where ip=\'$client\'");
26          $sth->execute();
27          $c = $sth->fetchrow_hashref();
28
29          if ($c->{blocked} eq "1") {
30                  send_answer($blocked);
31                  next;
32          }
33
34          if ($c->{whitelist_only} eq "1") {
35                  if (!is_on_list("dom_whitelist", $url)) {
36                          send_answer($blocked);
37                          next;
38                  }
39          }
40
41          if ($c->{filtered} eq "1") {
42                  if ($c->{games} eq "0") {
43                          # Check URL to see if it's on our games list
44                  }
45
46                  if ($c->{flash} eq "0") {
47                          # Check URL to see if it looks like flash
48                  }
49
50                  send_answer($url);
51                  next;
52          }
53
54          if ($c->{open} eq "1") {
55                  send_answer($url);
56                  next;
57          }
58
59          send_answer($url);
60          next;
61  }
62
63  exit 0;
64
65  #############################################################
66
67  sub     send_answer {
68          my($a) = @_;
69          print "$a\n";
70  }
71
72  sub     is_on_list {
73          my($list, $url) = @_;
74          my($o, @a, $i, @b, $b, $sth, $c);
75
76          $url =~ s/^https*:\/\///;
77          $url =~ s/^.+\@//;
78          $url =~ s/[:\/].*//;
79
80          @a = reverse(split(/\./, $url));
81
82          foreach $i (0 .. $#a) {
83                  push(@b, $a[$i]);
84                  $b = join(".", reverse(@b));
85
86                  $sth = $dbh->prepare("select count(*) from $list where name=\'$b\'");
87                  $sth->execute();
88                  ($c) = $sth->fetchrow_array();
89
90                  if ($c > 0) { return $c; }
91          }
92
93          return $c+0;
94  }
95