source: trunk/cgi-bin/CommonWeb.pm @ 4

Last change on this file since 4 was 4, checked in by Kris Deugau, 19 years ago

Import "new" IPDB development:

March 2004 through end of August 2004

Changes include:

-> Entirely new method of allocating IP space; which should

hopefully reduce the amount of messiness in allocations.

-> IP address processing provided by NetAddr::IP rather than

homebrew code

-> Change DB to PostgreSQL to eliminate some of the problems

caused by using MySQL, and to gain native RDBMS support for
IP addresses.

-> Using NetAddr::IP and Postgres allows (eventually, with

PG >= 7.4) IPV6 without any code changes. In theory.

-> Logging so that if someone makes a change that turns out

to have been wrong for some reason, Blame Can Be Assigned.

-> General code cleanups (split IPDB.pm from CommonWeb?.pm,

for instance)

  • Property svn:executable set to *
File size: 2.7 KB
Line 
1package CommonWeb;
2
3###
4# 08/13/2004 kdeugau@vianet
5#       Split DB-related functions into new module;  they're not
6#       specific to CGI/web stuff.
7###
8
9use strict;             
10use warnings;
11use Exporter;
12use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS);
13
14$VERSION     = 1.00;
15@ISA         = qw(Exporter);
16@EXPORT_OK      = qw(&parse_post &printFooter &printHeader &printError &printAndExit &desanitize &cleanInput &desanitize);
17
18@EXPORT      = (); #export nothing by default
19%EXPORT_TAGS = ( ALL => [qw( &parse_post &printFooter &printHeader &printError
20                                &printAndExit &desanitize &cleanInput )],
21                 lean    => [qw( &parse_post &printFooter &printHeader &printError
22                                &printAndExit &cleanInput )]
23                );
24
25sub parse_post {
26  my $buffer;
27  if ($ENV{'REQUEST_METHOD'} eq "GET") {
28    $buffer=$ENV{'QUERY_STRING'}
29  } elsif ($ENV{'REQUEST_METHOD'} eq 'POST' && $ENV{'CONTENT_TYPE'} eq "application/x-www-form-urlencoded") {
30    read(STDIN, $buffer, $ENV{CONTENT_LENGTH});
31  } else {
32    $buffer = $ENV{'QUERY_STRING'};
33    $buffer || read(STDIN, $buffer, $ENV{CONTENT_LENGTH});
34  }
35  my @pairs = split(/&/, $buffer);
36  my %webvarLocal;
37  foreach my $pair (@pairs) {
38    my ($name, $value) = split(/=/, $pair);
39    $name  =~ tr/+/ /;
40    $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
41    $value =~ tr/+/ /;
42    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
43    $value =~ s/\'/\\\'/g;
44    $webvarLocal{$name} = $value;
45  }
46  return %webvarLocal;
47}
48
49sub printHeader($) #(cgiurl)
50{
51        my $cgiURL = $_[0];
52        print "Content-type: text/html\n\n";
53        open(FILE, "../header.inc") || die $!;
54        while (<FILE>) 
55        {
56                $_ =~ s/\$\$CGIURL\$\$/$cgiURL/g;
57                print $_;
58        }
59        close(FILE);
60}
61
62sub printFooter
63{
64  open FILE, "../footer.inc"
65        or croak $!;
66  while (<FILE>) 
67  {
68    print;
69  }
70  close FILE;
71}
72
73sub printError($)
74{
75        my $errStr = $_[0];
76       
77        print qq(
78                <p>There was an error: $errStr</p>
79        );
80
81        printFooter();
82        exit(0);
83}
84
85sub printAndExit($)
86{
87        my $errStr = $_[0];
88        print qq(
89        <center><p class="regular"> $errStr </p>
90        <input type="button" value="Back" onclick="history.go(-1)">
91        </center>
92        );
93        printFooter();
94        exit(0);
95}
96
97sub loginAgain
98{
99        print qq(
100        <center><p>Your session has expired. Please login again.</p>
101        <p>
102        <a href="http://hosttest.vianet.ca"> Click here to login again.</a>
103        </p>
104        </center>
105        );
106        printFooter();
107        exit(0);
108}
109
110# needs a reference to the webvar hash.
111# takes out backticks and single quotes
112sub cleanInput($)
113{
114        my $hashRef = $_[0];
115
116        foreach my $key (keys %$hashRef) 
117        {
118                $hashRef->{$key} =~ s/`/\\`/g;
119                $hashRef->{$key} =~ s/'/\'/g;
120        }
121}
122
123# undoes clean input.  takes a string as an arg.
124sub desanitize($)
125{
126        my $string = $_[0];
127        $string =~ s/\\`/`/g;
128        $string =~ s/\\'/'/g;
129        return $string;
130}
131
132# indicate that the module loaded okay.
1331;
Note: See TracBrowser for help on using the repository browser.