1 | # Perl fragment for spitting out the browse pane of dnsbl.cgi and for browse.cgi
|
---|
2 | # Module-ized because it's apparently (next to) impossible to do a C-style
|
---|
3 | # "#include <file>", and this doesn't fit well into the main DNSBL module.
|
---|
4 | ##
|
---|
5 | # $Id: DNSBL.pm 48 2014-12-09 21:29:34Z kdeugau $
|
---|
6 | # Copyright 2014 Kris Deugau <kdeugau@deepnet.cx>
|
---|
7 | #
|
---|
8 | # This program is free software: you can redistribute it and/or modify
|
---|
9 | # it under the terms of the GNU General Public License as published by
|
---|
10 | # the Free Software Foundation, either version 3 of the License, or
|
---|
11 | # (at your option) any later version.
|
---|
12 | #
|
---|
13 | # This program is distributed in the hope that it will be useful,
|
---|
14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of
|
---|
15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
---|
16 | # GNU General Public License for more details.
|
---|
17 | #
|
---|
18 | # You should have received a copy of the GNU General Public License
|
---|
19 | # along with this program. If not, see <http://www.gnu.org/licenses/>.
|
---|
20 | ##
|
---|
21 |
|
---|
22 | package DNSBLweb;
|
---|
23 |
|
---|
24 | use Exporter;
|
---|
25 | use HTML::Template;
|
---|
26 | use NetAddr::IP;
|
---|
27 |
|
---|
28 | use DNSBL;
|
---|
29 |
|
---|
30 | sub retlvl {
|
---|
31 | my %ipseen;
|
---|
32 | my $dbh = shift;
|
---|
33 | my $dnsbl = shift;
|
---|
34 | my $lvl = shift;
|
---|
35 | if ($lvl > $DNSBL::maxlvl) {
|
---|
36 | warn "$lvl past max ".$DNSBL::maxlvl.", breaking off\n";
|
---|
37 | return;
|
---|
38 | }
|
---|
39 | my $ret = '';
|
---|
40 |
|
---|
41 | my %args = @_;
|
---|
42 | $args{ipseen} = \%ipseen if !defined($args{ipseen});
|
---|
43 | my $ip;
|
---|
44 | if ($args{ip}) {
|
---|
45 | $ip = $args{ip};
|
---|
46 | } else {
|
---|
47 | $ip = '0/0';
|
---|
48 | }
|
---|
49 | my $ipcidr = new NetAddr::IP $ip;
|
---|
50 | if (!$args{block}) {
|
---|
51 | # Safety net - Don't try to return the entire dataset if we were only passed an IP that
|
---|
52 | # is not in a known block
|
---|
53 | ($args{block}) = $dbh->selectrow_array("SELECT block FROM blocks WHERE block >> ? AND level=0", undef, $ip);
|
---|
54 | return '' if !$args{block};
|
---|
55 | }
|
---|
56 | my $pblock = $args{block} || '0/0';
|
---|
57 |
|
---|
58 | my $basesql = "SELECT b.block,o.orgname,b.listme,o.listme,b.comments,o.comments ".
|
---|
59 | "FROM blocks b INNER JOIN orgs o ON b.orgid=o.orgid ".
|
---|
60 | "WHERE b.block <<=";
|
---|
61 | my $allsth = $dbh->prepare($basesql."? AND b.level=? ORDER BY block");
|
---|
62 | my $sthiplist = $dbh->prepare("SELECT * FROM iplist WHERE ip <<= ? ORDER BY ip");
|
---|
63 | $allsth->execute($pblock,$lvl);
|
---|
64 | while (my ($block,$org,$listmeb,$listmeo,$bcomments,$ocomments) = $allsth->fetchrow_array) {
|
---|
65 | my $tmpl = new HTML::Template(filename => "browse-block.tmpl");
|
---|
66 | my $blockcidr = new NetAddr::IP $block;
|
---|
67 | $tmpl->param(lvlclass => "lvl$lvl".($dnsbl->autolist_block($block) ? " auto$lvl" : '').
|
---|
68 | ( $ipcidr->within($blockcidr) ? ' inhere' : ''));
|
---|
69 |
|
---|
70 | $tmpl->param(netclass => ($listmeb ? "b$lvl".'list' : ''));
|
---|
71 | $tmpl->param(net => $block);
|
---|
72 | $tmpl->param(orgclass => ($listmeo ? "b$lvl".'org' : ''));
|
---|
73 | $tmpl->param(org => $org);
|
---|
74 | $tmpl->param(bcomment => $bcomments) if $bcomments;
|
---|
75 | $tmpl->param(ocomment => $ocomments) if $ocomments;
|
---|
76 | $tmpl->param(indent => ' 'x$lvl);
|
---|
77 | $tmpl->param(subs => DNSBLweb::retlvl($dbh, $dnsbl, $lvl+1, block => $block, ip => $ip, ipseen => $args{ipseen}));
|
---|
78 | $sthiplist->execute($block);
|
---|
79 | my @iprows;
|
---|
80 | while (my @data4 = $sthiplist->fetchrow_array) {
|
---|
81 | next if $args{ipseen}->{$data4[0]};
|
---|
82 | my %iprow;
|
---|
83 | $iprow{ip} = $data4[0];
|
---|
84 | $iprow{ipcount} = $data4[1];
|
---|
85 | $iprow{indent} = ' 'x$lvl;
|
---|
86 | $iprow{repeater} = 1 if $ip eq $data4[0];
|
---|
87 | # ip | count | s4list | added
|
---|
88 | push @iprows, \%iprow;
|
---|
89 | $args{ipseen}->{$data4[0]} = 1;
|
---|
90 | }
|
---|
91 | $tmpl->param(iplist => \@iprows);
|
---|
92 | $ret .= $tmpl->output;
|
---|
93 | }
|
---|
94 | return $ret;
|
---|
95 | }
|
---|
96 |
|
---|
97 | # because Perl.
|
---|
98 | 1;
|
---|