# Perl fragment for spitting out the browse pane of dnsbl.cgi and for browse.cgi # Module-ized because it's apparently (next to) impossible to do a C-style # "#include ", and this doesn't fit well into the main DNSBL module. ## # $Id: DNSBL.pm 48 2014-12-09 21:29:34Z kdeugau $ # Copyright 2014 Kris Deugau # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation, either version 3 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see . ## package DNSBLweb; use Exporter; use HTML::Template; use NetAddr::IP; use DNSBL; sub retlvl { my %ipseen; my $dbh = shift; my $dnsbl = shift; my $lvl = shift; if ($lvl > $DNSBL::maxlvl) { warn "$lvl past max ".$DNSBL::maxlvl.", breaking off\n"; return; } my $ret = ''; my %args = @_; $args{ipseen} = \%ipseen if !defined($args{ipseen}); my $ip; if ($args{ip}) { $ip = $args{ip}; } else { $ip = '0/0'; } my $ipcidr = new NetAddr::IP $ip; if (!$args{block}) { # Safety net - Don't try to return the entire dataset if we were only passed an IP that # is not in a known block ($args{block}) = $dbh->selectrow_array("SELECT block FROM blocks WHERE block >> ? AND level=0", undef, $ip); return '' if !$args{block}; } my $pblock = $args{block} || '0/0'; my $basesql = "SELECT b.block,o.orgname,b.listme,o.listme,b.comments,o.comments ". "FROM blocks b INNER JOIN orgs o ON b.orgid=o.orgid ". "WHERE b.block <<="; my $allsth = $dbh->prepare($basesql."? AND b.level=? ORDER BY block"); my $sthiplist = $dbh->prepare("SELECT * FROM iplist WHERE ip <<= ? ORDER BY ip"); $allsth->execute($pblock,$lvl); while (my ($block,$org,$listmeb,$listmeo,$bcomments,$ocomments) = $allsth->fetchrow_array) { my $tmpl = new HTML::Template(filename => "browse-block.tmpl"); my $blockcidr = new NetAddr::IP $block; $tmpl->param(lvlclass => "lvl$lvl".($dnsbl->autolist_block($block) ? " auto$lvl" : ''). ( $ipcidr->within($blockcidr) ? ' inhere' : '')); $tmpl->param(netclass => ($listmeb ? "b$lvl".'list' : '')); $tmpl->param(net => $block); $tmpl->param(orgclass => ($listmeo ? "b$lvl".'org' : '')); $tmpl->param(org => $org); $tmpl->param(bcomment => $bcomments) if $bcomments; $tmpl->param(ocomment => $ocomments) if $ocomments; $tmpl->param(indent => ' 'x$lvl); $tmpl->param(subs => DNSBLweb::retlvl($dbh, $dnsbl, $lvl+1, block => $block, ip => $ip, ipseen => $args{ipseen})); $sthiplist->execute($block); my @iprows; while (my @data4 = $sthiplist->fetchrow_array) { next if $args{ipseen}->{$data4[0]}; my %iprow; $iprow{ip} = $data4[0]; $iprow{ipcount} = $data4[1]; $iprow{indent} = ' 'x$lvl; $iprow{repeater} = 1 if $ip eq $data4[0]; # ip | count | s4list | added push @iprows, \%iprow; $args{ipseen}->{$data4[0]} = 1; } $tmpl->param(iplist => \@iprows); $ret .= $tmpl->output; } return $ret; } # because Perl. 1;