...

View Full Version : Resolved Need help identifing Perl method



Budreaux
03-16-2010, 08:00 PM
Alright, i came across a script I modified many years ago and noticed that it will work (with a little tweaking) for something I am currently doing. Since I know I didn't fully understand what it was I was doing at the time and I probably was going from another script sample I found on the internet, I need to now identify what method(s) of Perl I am using in this script. Particularly the parts where I output html code tags. It seems to be an abbreviated form of some sort and that is what I need to identify. Here is the code.


#!/usr/bin/perl -w
use strict;

use CGI qw/:standard/;
use CGI::Carp qw/fatalsToBrowser/;

$CGI::POST_MAX = 350;

$ENV{PATH} = "/cgi-bin";

# declare/define variable names
my $lines;
my $status = 0;
my $elim = 35;
my $plim = 50;
my $clim = 199;

open(LOGFILE, "../logs/error_log") or die "Could not open log file: $!\n";
my @lines = <LOGFILE>;
close(LOGFILE);

my $last_line = "$lines[$#lines]";

# strip out html file name from error log string
if ($last_line =~ /^[\[]{1}([\w\s\:\[\]\.]+)(\/httpd\/htdocs\/{1})(.+)/)
{
$last_line = $3;
}else {
$last_line = "";
}

# sub for checking data and untainiting
sub stat_check {
$status = 1;
my $info1 = $ENV{'HTTP_REFERER'};
my $info2 = $ENV{'REMOTE_ADDR'};
my $_email = param('email');
my $_page = param('page');
my $_comments = param('comments');
my @vars;

if (!$_email) {
my $gemail = "No email address provided";
push(@vars,$gemail);
return @vars;
}elsif (length ($_email) > $elim) {
print 'The email address you entered is too long.&nbsp; Please recheck your address';
$status = 0;
}elsif ($_email !~ /[\%\$\^\!\*\(\)\[\]\\\|\{\}\;\<\>]/ && $_email =~ /^(\w{1}[\w\-\.]+\@{1}[\w\-\.]+\.{1}\w{2,4})$/i) {
my $gemail = "$1";
push(@vars,$gemail);
return @vars;
}else {
print 'Please use only alphanumeric characters, dashes, &quot;@&quot;, periods or underscores in your email address';
$status = 0;
}

if (!$_page) {
my $gpage = "No page info given";
push (@vars,$gpage);
return @vars;
}elsif (length ($_page) > $plim) {
print 'The page length is too long.&nbsp; Be sure too leave off the &quot;http://www.&quot;';
$status = 0;
}elsif ($_page !~ /[\%\&\$\^\!\*\(\)\[\]\\\|\{\}\;\<\>]+/ && $_page =~ /^([\w\.\/\-]+)(\.{1}\w{2,5})$/i) {
my $gpage = "$1$2";
push (@vars,$gpage);
return @vars;
}else {
print 'Please use only alphanumeric characters, dashes, &quot;@&quot;, periods or underscores in your email address';
$status = 0;
}

if (!$_comments) {
my $gcomments = "No comments entered";
push (@vars,$gcomments);
return @vars;
}elsif (length ($_comments) > $clim) {
print 'Please keep your comments to 200 characters or less (spaces count as a character)';
$status = 0;
}elsif ($_comments !~ /[\%\$\^\!\*\(\)\[\]\\\|\{\}\;\<\>\&]+/ && $_comments =~ /^([\w\s\.\,]+)/i) {
my $gcomments = $1;
push (@vars,$gcomments);
return @vars;
}else {
print 'Please use only alphanumeric characters, dashes, &quot;@&quot;, periods or underscores in your email address';
$status = 0;
}

if (!$info1) {
my $info1 = "No URL available";
push (@vars,$info1);
return @vars;
}elsif ($info1 !~ /[%\$\^\!\*\(\)\[\]\\\|\{\}\;\<\>]+/ && $info1 =~ /^(http{1}.+)/) {
my $info1 = "$1";
push (@vars,$info1);
return @vars;
}else {
my $info1 = "Bad URL submitted";
push (@vars,$info1);
return @vars;
}

if (!$info2) {
my $info2 = "No IP address available";
push (@vars,$info2);
return @vars;
}elsif ($info2 !~ /[\%]+/ && $info2 =~ /^(\d{1,3}\.{1})(\d{1,3}\.{1})(\d{1,3}\.{1})(\d{1,3})$/) {
my $info2 = "$1$2$3$4";
push (@vars,$info2);
return @vars;
}else {
my $info2 = "Bad IP address submitted";
push (@vars,$info2);
return @vars;
}
}

# Begin second page
print header;

if (param()) {
my $_email = param('email');
my $_page = param('page');
my $_comments = param('comments');
if (stat_check()) {
&mailoff;
exit; }
}

# Begin intro page
print start_form,
h1({style=>'color: #06C;'},'Error - Page Not Found!'),
p({style=>'font: 1em Arial, sans-serif;'},'We're sorry, but the page
you were looking for has either been changed, moved, or has been
deleted.&nbsp; Please return to our ',a({href=>'http://www.memco.us'},'homepage'),' to locate the proper
page.&nbsp; You may also fill out the form below to help us better understand why you arrived at this error page.'),
p({style=>'font: 1em Arial, sans-serif;'},'If you arrived at this page via a &quot;bookmark&quot;, please delete the link as it no longer works.'),
br,hr,br,
'Email address &lt;optional&gt;:&nbsp; ',br,
textfield('email','',35),
br,br,
'This is the page you were trying to access.',br,
textfield('page',$last_line,50),
br,br,
'Additional information:',br,
textarea('comments','',4,40),
br,br,
submit,
end_form;

# Begin subs
sub mailoff {

my $mailprog = '/usr/sbin/sendmail';
my $recipient = 'me@here.com';
my @vars = &stat_check('vars');

open (MAIL, "|$mailprog -t") or diemail ("Can't access $mailprog!\n");

print MAIL "To: $recipient\n";
print MAIL "Subject: Error 404\n\n";

print MAIL "The following information has been supplied due to an Error 404.\n";
print MAIL "\n";
print MAIL "Message sender: $vars[0] $vars[4]\n\n";
print MAIL "Tried to access $vars[1]\n\n";
print MAIL "Comments:\n";
print MAIL "$vars[2]\n\n";
print MAIL "Refering page: $vars[3]\n";

close(MAIL);

print start_html(title=>'Thank You');
h1('Thank You!'),
p('Your information has been submitted&nbsp; This information will enable us to locate your particular problem and fix it.'),
end_html;
}

sub diemail {
my $msg = shift;
print start_html,
p ($msg),
end_html;
}

If you look the "#begin intro page" section, there are a bunch of html tags that seem to be coded in a short form sort of way. What I want to do is make the "page" textfield read only. I think it goes like this



textfield('page', $last_line,50,readonly)'


but without any way to check documentation, I can't be sure. I know this is a particular method of the CGI.PM module, but I can't find anything on it now. Please help. Thanks.

Budreaux
03-16-2010, 08:47 PM
OK, I found my answer. What I was looking at was the old style of using CGI.PM. I should be using the named parameter style which will allow me to use the read only parameter.



EZ Archive Ads Plugin for vBulletin Copyright 2006 Computer Help Forum