$config{pgtitle}

#!/usr/bin/perl # quickndirty browse-the-damned-by-web ## # $Id$ # Copyright 2009-2012,2014,2018 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 . ## use strict; use warnings; use DBI; use CGI::Carp qw(fatalsToBrowser); use CGI::Simple; use HTML::Template; # push "the directory the script is in" into @INC use FindBin; use lib "$FindBin::RealBin/"; use DNSBL 2.2; use DNSBLweb; my $dnsbl = new DNSBL; # default DB info - all other settings should be loaded from the DB. my $dbhost = "localhost"; my $dbname = "dnsbl"; my $dbuser = "dnsbl"; my $dbpass = "spambgone"; # Load a config ref containing DB host, name, user, and pass info based on # from the server name + full script web path. This allows us to host # multiple instances without having to duplicate the code. # This file is a Perl fragment to be processed inline. my $cfgname = $ENV{SERVER_NAME}.$ENV{SCRIPT_NAME}; $cfgname =~ s|[./-]|_|g; $cfgname =~ s|_browse_cgi||; if (-e "/etc/dnsbl/$cfgname.conf") { my $cfg = `cat /etc/dnsbl/$cfgname.conf`; ($cfg) = ($cfg =~ /^(.+)$/s); # avoid warnings, failures, and general nastiness with taint mode eval $cfg; } # Set up the CGI object... my $q = new CGI::Simple; # ... and get query-string params as well as POST params if necessary $q->parse_query_string; my %webvar; # This is probably excessive fiddling, but it puts the parameters somewhere my fingers know about... foreach ($q->param()) { $webvar{$_} = $q->param($_); } # try to be friendly to non-US-ASCII characters. Still need to find what # difference from RH<->Debian is still at fault. print $q->header(-charset=>'utf8'); my $dbh = $dnsbl->connect($dbhost, $dbname, $dbuser, $dbpass); my $block = ''; my $templatedir = $ENV{SCRIPT_FILENAME}; $templatedir =~ s/browse\.cgi//; $templatedir .= "templates"; $ENV{HTML_TEMPLATE_ROOT} = $templatedir; my %config; my $sth = $dbh->prepare("SELECT key,value FROM misc"); $sth->execute; while (my ($key,$value) = $sth->fetchrow_array) { $config{$key} = $value; } # basic validation so we don't try to look up something ridiculous if ($webvar{block}) { $webvar{block} =~ s/\s+//g; $block = $webvar{block} if $webvar{block} =~ /^[\d\.]+(?:\/\d+)?$/; } if ($block) { my $template = HTML::Template->new(filename => "browse.tmpl"); $template->param(pgtitle => $config{pgtitle}) if defined($config{pgtitle}); $template->param(pgcomment => $config{pgcomment}) if defined($config{pgcomment}); my $out; if ($block =~ /^[\d\.]+$/) { $out = DNSBLweb::retlvl($dbh, $dnsbl, 0, ip => $block, block => $dnsbl->getcontainer($block,0) ); } else { $out = DNSBLweb::retlvl($dbh, $dnsbl, 0, block => $block); } $template->param(enchilada => $out); print $template->output; } else { # refuse to show the whole tree, as in a "real" dataset it's horribly slow. even a /8 is often "a bit much" print qq( $config{pgtitle} $config{pgcomment}
); if ($webvar{block}) { $webvar{block} =~ s{[^\w]+}{_}g; #neuter any attempts at funky data injection print qq(Invalid netblock specification $webvar{block}\n); } print qq( ); }