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 strict;
|
---|
25 | use warnings;
|
---|
26 |
|
---|
27 | use Exporter;
|
---|
28 | use HTML::Template;
|
---|
29 | use NetAddr::IP;
|
---|
30 |
|
---|
31 | use DNSBL;
|
---|
32 |
|
---|
33 | sub retlvl {
|
---|
34 | my %ipseen;
|
---|
35 | my $dbh = shift;
|
---|
36 | my $dnsbl = shift;
|
---|
37 | my $lvl = shift;
|
---|
38 | if ($lvl > $DNSBL::maxlvl) {
|
---|
39 | warn "$lvl past max ".$DNSBL::maxlvl.", breaking off\n";
|
---|
40 | return;
|
---|
41 | }
|
---|
42 | my $ret = '';
|
---|
43 |
|
---|
44 | my %args = @_;
|
---|
45 | $args{ipseen} = \%ipseen if !defined($args{ipseen});
|
---|
46 | my $ip;
|
---|
47 | if ($args{ip}) {
|
---|
48 | $ip = $args{ip};
|
---|
49 | } else {
|
---|
50 | $ip = '0/0';
|
---|
51 | }
|
---|
52 | my $ipcidr = new NetAddr::IP $ip;
|
---|
53 | if (!$args{block}) {
|
---|
54 | # Safety net - Don't try to return the entire dataset if we were only passed an IP that
|
---|
55 | # is not in a known block
|
---|
56 | ($args{block}) = $dbh->selectrow_array("SELECT block FROM blocks WHERE block >> ? AND level=0", undef, $ip);
|
---|
57 | return '' if !$args{block};
|
---|
58 | }
|
---|
59 | my $pblock = $args{block} || '0/0';
|
---|
60 |
|
---|
61 | my $basesql = "SELECT b.block,o.orgname,b.listme,o.listme,b.comments,o.comments,b.exclude ".
|
---|
62 | "FROM blocks b INNER JOIN orgs o ON b.orgid=o.orgid ".
|
---|
63 | "WHERE b.block <<=";
|
---|
64 | my $allsth = $dbh->prepare($basesql."? AND b.level=? ORDER BY block");
|
---|
65 | my $sthiplist = $dbh->prepare("SELECT * FROM iplist WHERE ip <<= ? ORDER BY ip");
|
---|
66 | $allsth->execute($pblock,$lvl);
|
---|
67 | while (my ($block,$org,$listmeb,$listmeo,$bcomments,$ocomments,$bexclude) = $allsth->fetchrow_array) {
|
---|
68 | my $tmpl = new HTML::Template(filename => "browse-block.tmpl");
|
---|
69 | my $blockcidr = new NetAddr::IP $block;
|
---|
70 | $tmpl->param(lvlclass => "lvl$lvl".($dnsbl->autolist_block($block) ? " auto$lvl" : '').
|
---|
71 | ( $ipcidr->within($blockcidr) ? ' inhere' : ''));
|
---|
72 | # exclude takes precedence over listme
|
---|
73 | $tmpl->param(netclass => ($bexclude ? 'exclude' : ($listmeb ? "b$lvl".'list' : '')));
|
---|
74 | $tmpl->param(net => $block);
|
---|
75 | $tmpl->param(orgclass => ($listmeo ? "b$lvl".'org' : ''));
|
---|
76 | $tmpl->param(org => $org);
|
---|
77 | $tmpl->param(bcomment => $bcomments) if $bcomments;
|
---|
78 | $tmpl->param(ocomment => $ocomments) if $ocomments;
|
---|
79 | $tmpl->param(indent => ' 'x$lvl);
|
---|
80 | $tmpl->param(subs => DNSBLweb::retlvl($dbh, $dnsbl, $lvl+1, block => $block, ip => $ip, ipseen => $args{ipseen}));
|
---|
81 | $sthiplist->execute($block);
|
---|
82 | my @iprows;
|
---|
83 | while (my @data4 = $sthiplist->fetchrow_array) {
|
---|
84 | next if $args{ipseen}->{$data4[0]};
|
---|
85 | my %iprow;
|
---|
86 | my @ipclass;
|
---|
87 | $iprow{ip} = $data4[0];
|
---|
88 | $iprow{ipcount} = $data4[1];
|
---|
89 | $iprow{indent} = ' 'x$lvl;
|
---|
90 | push @ipclass, 'repeater' if $ip eq $data4[0];
|
---|
91 | push @ipclass, 'exclude' if $data4[5];
|
---|
92 | $iprow{ipclass} = join(' ', @ipclass);
|
---|
93 | # ip | count | s4list | added | parent | exclude
|
---|
94 | push @iprows, \%iprow;
|
---|
95 | $args{ipseen}->{$data4[0]} = 1;
|
---|
96 | }
|
---|
97 | $tmpl->param(iplist => \@iprows);
|
---|
98 | $ret .= $tmpl->output;
|
---|
99 | }
|
---|
100 | return $ret;
|
---|
101 | }
|
---|
102 |
|
---|
103 | # because Perl.
|
---|
104 | 1;
|
---|