source: trunk/uribl/uridb.cgi@ 57

Last change on this file since 57 was 41, checked in by Kris Deugau, 13 years ago

/trunk/uribl

Minor cleanup and GPL-tagging for release

  • Property svn:executable set to *
  • Property svn:keywords set to Date Rev Author Id
File size: 4.0 KB
RevLine 
[27]1#!/usr/bin/perl
[41]2# Web UI for adding URIs to blacklist
3##
4# $Id: uridb.cgi 41 2012-03-04 20:52:10Z 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;
27use URIdb;
28
29# Set up the CGI object...
30my $q = new CGI::Simple;
31# ... and get query-string params as well as POST params if necessary
32$q->parse_query_string;
33
34my %webvar;
35# This is probably excessive fiddling, but it puts the parameters somewhere my fingers know about...
36foreach ($q->param()) {
37 $webvar{$_} = $q->param($_);
38}
39
40my $uridb = new URIdb;
41
42print "Content-type: text/html\n\n";
43
44# default DB info - all other settings should be loaded from the DB.
45my $dbhost = "localhost";
46my $dbname = "uridb";
47my $dbuser = "uridb";
48my $dbpass = "spambgone";
49
50#my %status = (0 => "Don't list",
51# 2 => "Black",
52# 4 => "Grey",
53# 8 => "Abused URL shortener/redirector"
54# );
55
56# Load a config ref containing DB host, name, user, and pass info based on
57# from the server name + full script web path. This allows us to host
58# multiple instances without having to duplicate the code.
59# This file is a Perl fragment to be processed inline.
60my $cfgname = $ENV{SERVER_NAME}.$ENV{REQUEST_URI};
61$cfgname =~ s|[./-]|_|g;
62$cfgname =~ s|_uridb_cgi.*||;
63$cfgname =~ s|_$||;
64if (-e "/etc/uridb/$cfgname.conf") {
65 my $cfg = `cat /etc/uridb/$cfgname.conf`;
66 ($cfg) = ($cfg =~ /^(.+)$/s); # avoid warnings, failures, and general nastiness with taint mode
67 eval $cfg;
68}
69
70my $dbh = $uridb->connect($dbhost, $dbname, $dbuser, $dbpass);
71
72my $page;
73my $templatedir = $ENV{SCRIPT_FILENAME};
74$templatedir =~ s/uridb\.cgi//;
75$templatedir .= "templates";
76$ENV{HTML_TEMPLATE_ROOT} = $templatedir;
77
78my $cgiself = $ENV{SCRIPT_FILENAME};
79$cgiself =~ s|.+/([^/]+\.cgi)$|$1|;
80
81my %config;
82my $sth = $dbh->prepare("SELECT key,value FROM misc");
83$sth->execute;
84while (my ($key,$value) = $sth->fetchrow_array) {
85 $config{$key} = $value;
86}
87
88# decide which page to spit out...
89if (!$webvar{page}) {
90 $page = HTML::Template->new(filename => "index.tmpl");
91} else {
92 $page = HTML::Template->new(filename => "$webvar{page}.tmpl");
93}
94
95$page->param(pgtitle => $config{pgtitle}) if defined($config{pgtitle});
96$page->param(pgcomment => $config{pgcomment}) if defined($config{pgcomment});
97$page->param(cgiself => $cgiself);
98
99my $uridbsiteroot = $ENV{REQUEST_URI};
100$uridbsiteroot =~ s|/uridb\.cgi\?.+|/|;
101$page->param(uridbsiteroot => $uridbsiteroot);
102
103if ($webvar{page} eq 'report') {
104
105 my @dombase = split /\n/m, $webvar{domlist};
106 my @domlist;
107 my $domcount = 0;
108 foreach my $domain (@dombase) {
109 my %row;
110 $row{domindex} = $domcount++;
111 ($domain) = split /:/, $domain;
112 $domain =~ s/^\+//;
113 $domain =~ s/\.uribl.company.com//;
114 chomp $domain;
115 $row{domain} = $domain;
116 push @domlist, \%row;
117 }
118 $page->param(domlist => \@domlist);
119
120} elsif ($webvar{page} eq 'dbreport') {
121
122 my $err = '';
123 my @domlist;
[28]124 my $i = 0;
125 while (defined ($webvar{"dom$i"})) {
126 my $key = "dom$i";
[27]127 my %row;
128 $row{domain} = $webvar{$key};
129 $row{listnum} = $webvar{$key."type"};
130 $row{listtext} = $URIdb::status{$webvar{$key."type"}};
[28]131 $row{comment} = $webvar{$key."comment"};
[27]132 if ($webvar{$key."type"} != 0) {
133 $uridb->report($webvar{$key},$webvar{$key."type"},$webvar{$key."comment"});
134 }
135 push @domlist, \%row;
[28]136 $i++;
[27]137 }
138 $page->param(domlist => \@domlist);
139 $page->param(err => $err);
140
141}
142
143print $page->output;
144
145exit 0;
Note: See TracBrowser for help on using the repository browser.