#!/usr/bin/perl # Web UI for adding URIs to blacklist ## # $Id$ # Copyright 2010 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; no warnings qw(uninitialized); use CGI::Carp qw (fatalsToBrowser); use CGI::Simple; use HTML::Template; use Encode; use URIdb; # 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($_); } my $uridb = new URIdb; print $q->header(-charset=>'utf8'); # default DB info - all other settings should be loaded from the DB. my $dbhost = "localhost"; my $dbname = "uridb"; my $dbuser = "uridb"; my $dbpass = "spambgone"; #my %status = (0 => "Don't list", # 2 => "Black", # 4 => "Grey", # 8 => "Abused URL shortener/redirector" # ); # 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{REQUEST_URI}; $cfgname =~ s|[./-]|_|g; $cfgname =~ s|_uridb_cgi.*||; $cfgname =~ s|_$||; if (-e "/etc/uridb/$cfgname.conf") { my $cfg = `cat /etc/uridb/$cfgname.conf`; ($cfg) = ($cfg =~ /^(.+)$/s); # avoid warnings, failures, and general nastiness with taint mode eval $cfg; } my $dbh = $uridb->connect($dbhost, $dbname, $dbuser, $dbpass); my $page; my $cgiself = $ENV{SCRIPT_FILENAME}; $cgiself =~ s|.+/([^/]+\.cgi)$|$1|; my $templatedir = $ENV{SCRIPT_FILENAME}; $templatedir =~ s/$cgiself//; $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; } # decide which page to spit out... if (!$webvar{page}) { $page = HTML::Template->new(filename => "index.tmpl"); } else { $page = HTML::Template->new(filename => "$webvar{page}.tmpl"); } $page->param(pgtitle => $config{pgtitle}) if defined($config{pgtitle}); $page->param(pgcomment => $config{pgcomment}) if defined($config{pgcomment}); $page->param(cgiself => $cgiself); my $uridbsiteroot = $ENV{REQUEST_URI}; $uridbsiteroot =~ s|/$cgiself\?.+|/|; $page->param(uridbsiteroot => $uridbsiteroot); if ($webvar{page} eq 'report') { my @dombase = split /\n/m, $webvar{domlist}; my @domlist; my $domcount = 0; foreach my $domain (@dombase) { my %row; ($domain) = split /:/, $domain; $domain =~ s/^\+//; $domain =~ s/\.uribl.company.com//; chomp $domain; # now, see if it's multilisted if ($domain =~ / on (\w+)\s*$/) { my $sub = $1; #$domain =~ s/ on \w+\s*$//; $domlist[$domcount-1]->{otherlists} .= ",$sub"; next; } $row{domindex} = $domcount++; $row{domain} = $domain; push @domlist, \%row; } $page->param(domlist => \@domlist); } elsif ($webvar{page} eq 'dbreport') { my $err = ''; my @domlist; my $i = 0; while (defined ($webvar{"dom$i"})) { my $key = "dom$i"; my %row; $row{domain} = $webvar{$key}; $row{listnum} = $webvar{$key."type"}; $row{listtext} = $URIdb::status{$webvar{$key."type"}}; $row{comment} = $webvar{$key."comment"}; if ($webvar{$key."type"} != 0) { $uridb->report($webvar{$key},$webvar{$key."type"},$webvar{$key."comment"}); } push @domlist, \%row; $i++; } $page->param(domlist => \@domlist); $page->param(err => $err); } print $page->output; exit 0;