source: trunk/dnsbl/DNSBLweb.pm@ 69

# 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 <file>", and this doesn't fit well into the main DNSBL module.
##
# $Id: DNSBLweb.pm 68 2018-01-10 22:05:30Z kdeugau $
# Copyright 2014,2018 Kris Deugau <kdeugau@deepnet.cx>
#
#    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 <http://www.gnu.org/licenses/>.
##

package DNSBLweb;

use strict;
use warnings;

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,b.exclude ".
       "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,$bexclude) = $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' : ''));
    # exclude takes precedence over listme
    $tmpl->param(netclass => ($bexclude ? 'exclude' : ($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;
      my @ipclass;
      $iprow{ip} = $data4[0];
      $iprow{ipcount} = $data4[1];
      $iprow{indent} = '  'x$lvl;
      push @ipclass, 'repeater' if $ip eq $data4[0];
      push @ipclass, 'exclude' if $data4[5];
      $iprow{ipclass} = join(' ', @ipclass);
#       ip        | count | s4list |             added             |     parent     | exclude
      push @iprows, \%iprow;
      $args{ipseen}->{$data4[0]} = 1;
    }
    $tmpl->param(iplist => \@iprows);
    $ret .= $tmpl->output;
  }
  return $ret;
}

# because Perl.
1;