source: trunk/uribl/uridb.cgi

Last change on this file was 62, checked in by Kris Deugau, 9 years ago

/trunk/uribl

Commit accumulated tweaks and fixes from production:

  • add "use Encode;" and set the HTTP charset header to deal with non-ASCII more sanely
  • reorder mangling of request-URI components a little so we can symlink index.cgi -> uridb.cgi
  • collapse results from extract-data showing a hit on some other DNSBL into a single field rather than just treating it as "another domain" that needs to be hand-reflagged as "don't list"
  • use POST for form submissions; mainly to clean up the working URL
  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 4.3 KB
RevLine 
[27]1#!/usr/bin/perl
[41]2# Web UI for adding URIs to blacklist
3##
4# $Id: uridb.cgi 62 2016-02-12 20:45:59Z kdeugau $
5# Copyright 2010 Kris Deugau <kdeugau@deepnet.cx>
6#
7# This program is free software: you can redistribute it and/or modify
8# it under the terms of the GNU General Public License as published by
9# the Free Software Foundation, either version 3 of the License, or
10# (at your option) any later version.
11#
12# This program is distributed in the hope that it will be useful,
13# but WITHOUT ANY WARRANTY; without even the implied warranty of
14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15# GNU General Public License for more details.
16#
17# You should have received a copy of the GNU General Public License
18# along with this program. If not, see <http://www.gnu.org/licenses/>.
19##
[27]20
21use strict;
22use warnings;
23no warnings qw(uninitialized);
24use CGI::Carp qw (fatalsToBrowser);
25use CGI::Simple;
26use HTML::Template;
[62]27use Encode;
28
[27]29use URIdb;
30
31# Set up the CGI object...
32my $q = new CGI::Simple;
33# ... and get query-string params as well as POST params if necessary
34$q->parse_query_string;
35
36my %webvar;
37# This is probably excessive fiddling, but it puts the parameters somewhere my fingers know about...
38foreach ($q->param()) {
39 $webvar{$_} = $q->param($_);
40}
41
42my $uridb = new URIdb;
43
[62]44print $q->header(-charset=>'utf8');
[27]45
46# default DB info - all other settings should be loaded from the DB.
47my $dbhost = "localhost";
48my $dbname = "uridb";
49my $dbuser = "uridb";
50my $dbpass = "spambgone";
51
52#my %status = (0 => "Don't list",
53# 2 => "Black",
54# 4 => "Grey",
55# 8 => "Abused URL shortener/redirector"
56# );
57
58# Load a config ref containing DB host, name, user, and pass info based on
59# from the server name + full script web path. This allows us to host
60# multiple instances without having to duplicate the code.
61# This file is a Perl fragment to be processed inline.
62my $cfgname = $ENV{SERVER_NAME}.$ENV{REQUEST_URI};
63$cfgname =~ s|[./-]|_|g;
64$cfgname =~ s|_uridb_cgi.*||;
65$cfgname =~ s|_$||;
66if (-e "/etc/uridb/$cfgname.conf") {
67 my $cfg = `cat /etc/uridb/$cfgname.conf`;
68 ($cfg) = ($cfg =~ /^(.+)$/s); # avoid warnings, failures, and general nastiness with taint mode
69 eval $cfg;
70}
71
72my $dbh = $uridb->connect($dbhost, $dbname, $dbuser, $dbpass);
73
74my $page;
[62]75
76my $cgiself = $ENV{SCRIPT_FILENAME};
77$cgiself =~ s|.+/([^/]+\.cgi)$|$1|;
78
[27]79my $templatedir = $ENV{SCRIPT_FILENAME};
[62]80$templatedir =~ s/$cgiself//;
[27]81$templatedir .= "templates";
82$ENV{HTML_TEMPLATE_ROOT} = $templatedir;
83
84my %config;
85my $sth = $dbh->prepare("SELECT key,value FROM misc");
86$sth->execute;
87while (my ($key,$value) = $sth->fetchrow_array) {
88 $config{$key} = $value;
89}
90
91# decide which page to spit out...
92if (!$webvar{page}) {
93 $page = HTML::Template->new(filename => "index.tmpl");
94} else {
95 $page = HTML::Template->new(filename => "$webvar{page}.tmpl");
96}
97
98$page->param(pgtitle => $config{pgtitle}) if defined($config{pgtitle});
99$page->param(pgcomment => $config{pgcomment}) if defined($config{pgcomment});
100$page->param(cgiself => $cgiself);
101
102my $uridbsiteroot = $ENV{REQUEST_URI};
[62]103$uridbsiteroot =~ s|/$cgiself\?.+|/|;
[27]104$page->param(uridbsiteroot => $uridbsiteroot);
105
106if ($webvar{page} eq 'report') {
107
108 my @dombase = split /\n/m, $webvar{domlist};
109 my @domlist;
110 my $domcount = 0;
111 foreach my $domain (@dombase) {
112 my %row;
113 ($domain) = split /:/, $domain;
114 $domain =~ s/^\+//;
115 $domain =~ s/\.uribl.company.com//;
116 chomp $domain;
[62]117 # now, see if it's multilisted
118 if ($domain =~ / on (\w+)\s*$/) {
119 my $sub = $1;
120 #$domain =~ s/ on \w+\s*$//;
121 $domlist[$domcount-1]->{otherlists} .= ",$sub";
122 next;
123 }
124 $row{domindex} = $domcount++;
[27]125 $row{domain} = $domain;
126 push @domlist, \%row;
127 }
[62]128
[27]129 $page->param(domlist => \@domlist);
130
131} elsif ($webvar{page} eq 'dbreport') {
132
133 my $err = '';
134 my @domlist;
[28]135 my $i = 0;
136 while (defined ($webvar{"dom$i"})) {
137 my $key = "dom$i";
[27]138 my %row;
139 $row{domain} = $webvar{$key};
140 $row{listnum} = $webvar{$key."type"};
141 $row{listtext} = $URIdb::status{$webvar{$key."type"}};
[28]142 $row{comment} = $webvar{$key."comment"};
[27]143 if ($webvar{$key."type"} != 0) {
144 $uridb->report($webvar{$key},$webvar{$key."type"},$webvar{$key."comment"});
145 }
146 push @domlist, \%row;
[28]147 $i++;
[27]148 }
149 $page->param(domlist => \@domlist);
150 $page->param(err => $err);
151
152}
153
154print $page->output;
155
156exit 0;
Note: See TracBrowser for help on using the repository browser.