Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

website Form (Perl script) Error: "Can't Save File"

Status
Not open for further replies.

reallygreen

IS-IT--Management
Aug 10, 2011
4
0
0
US
The website that I maintain has a very basic form that allows an upload of an attachment, either .doc or .txt using Perl script. After filling the form out, attaching a file and clicking submit I recieve this error: Can't Save File (and points to the folder that I created on the server where the file is supposed to be saved). Any help would be appreciated.
 
Make sure that the folder that you are saving it to has permission for the user who is running the apache/iis service to save to. If apache is running as the user www, then the user need read/write permissions to that folder.




~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
[noevil]
Travis - Those who say it cannot be done are usually interrupted by someone else doing it; Give the wrong symptoms, get the wrong solutions;
 
Thanks Travis! Right after I posted here I realized that I had overlooked that. I see the attachment on the server now, however I have yet to figure out why it will not send to my email. Any pointers? Thanks again for your first reply.
 
That could be a whole list of issues, what are you using to send it? How are you talking to it, etc,etc. Most of the time you can send email out via a local smtp server, but if your hosted they might not allow that.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
[noevil]
Travis - Those who say it cannot be done are usually interrupted by someone else doing it; Give the wrong symptoms, get the wrong solutions;
 
This is what I have set up to send the form and information. What am I doing wrong here?

my $script_name = 'sendresults.pl';
my $HTML_thankyou = 'my $to = 'webmaster@aplaceeeonthenet.com';
my $from = 'adude@aplaceeeonthenet.com';
my $mailprog = '/usr/sbin/sendmail';
my $subject = 'From the Place';
 
Well, first the assumption is they are going to let you use sendmail and it actually exists at that location. If that is correct it depends on how you are calling it. Can you provide the line(s) where you call the script? If you put it in the code brackets it helps also (Check out the TGML link).

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
[noevil]
Travis - Those who say it cannot be done are usually interrupted by someone else doing it; Give the wrong symptoms, get the wrong solutions;
 
Hopefully this helps? Thanks again.

use CGI qw/:standard :cgi-lib/;

@date=localtime();
$date[4]++;
$date[5]+=1900;
$date="$date[5]-$date[4]-$date[3]";

%FORM = parse_cgi();

# check required fields param in form if necessary
if ($required_fields_form) {
my $reqfields = $FORM{required_fields};
$reqfields =~ s/\s//g;
@required_fields = ();
@required_fields = split(/,/,$reqfields);
$reqfields = $FORM{required_fields_numbers};
$reqfields =~ s/\s//g;
@required_fields_numbers = ();
@required_fields_numbers = split(/,/,$reqfields);
$reqfields = $FORM{required_fields_email};
$reqfields =~ s/\s//g;
@required_fields_email = ();
@required_fields_email = split(/,/,$reqfields);
}

if($FORM{mode} eq $admin_mode){
if($FORM{login}){
if ($FORM{login} eq $username && $FORM{password} eq $password){$FORM{hash}=crypt($password,$username);}
else{promt();}
}
elsif ($FORM{hash} ne crypt($password,$username)){promt()};
#read log file
open(F, "$log_name") or error("Can't open log-file");
local $/;
my $data = <F>;
close F;
$seperator.="\n";
@data = split($seperator, $data);
#delete if act=delete
if ($FORM{action} eq 'delete'){
@items =split(", ", $FORM{Item});

for(@items){$Items{$_}=1;}
#error($Items{1});
my $i=1;
my $a=0;
my @new_data;
for(@data){
unless($Items{($i)}){
$new_data[$a++] = $_ ;

}
$i++;
}
@data=@new_data;
open (LOG, ">$log_name") or error("Can't open log file");
print LOG join("$seperator",@data);
close LOG;
print "Location: $script_name?mode=$admin_mode&hash=$FORM{hash}\n\n";
exit;
}

my $total = @data;
my $i=1;
my $txt = qq~
<script>
function deleteItem(){
myform.submit();
}
</script>
<form name=myform><input type=hidden name=mode value=$admin_mode>
<input type=hidden name=action value=delete>
<input type=hidden name=hash value=$FORM{hash}>
<table width=600><tr><th class=of align=center>Total Emails: $total</th></tr>
<tr><td class=off align=right><a href=javascript:deleteItem()>delete marked messages</a>&nbsp;</td></tr>~;
for(@data){
$_=~s/\n/<br>/g;
$txt.= "<tr><td class=of>&nbsp;Email #$i</td></tr>";
$txt.= "<tr><td class=off>$_</td></tr>";
$txt.= "<tr><td class=off align=right><a href=$script_name?mode=$admin_mode&action=delete&Item=$i&hash=$FORM{hash}>delete</a> <input type=checkbox name=Item value=$i>&nbsp;</td></tr>";
$i++;
}
$txt.="</table></form>";

html_text($txt);

exit;
}

push @required_fields,$field_name_email unless $to;
push @required_fields_email,$from_field_name if $FORM{$from_field_name};
test_form();
my @to = ();
my $logText = "";
foreach(@field){
if ($_ eq $from_field_name){
$from = $FORM{$from_field_name} if $FORM{$from_field_name};
error("$from_field_name_error") if length($FORM{$from_field_name})>40;
error("$from_field_name_error") if $FORM{$from_field_name}=~m/:/s;
error("$from_field_name_error") if $FORM{$from_field_name}=~m/Content-type/is;
error("$from_field_name_error") if $FORM{$from_field_name}=~m/\n/is;
$from =~ s/<([^>]|\n)*>//gs;
$from =~ s/ //gs;
$from =~ s/\n|\r//gs;
$message.="$_: " unless $send_just_data;
$message.="$FORM{$_}\n";
$logText.="$_: " unless $data_only;
$logText.="$FORM{$_}\n";
}
elsif ($_ eq $subject_field){$subject = $FORM{$subject_field} if $FORM{$subject_field};}
elsif ($_ eq $HTML_thankyou_field_name){$HTML_thankyou = $ThankYou{$FORM{$HTML_thankyou_field_name}} if $ThankYou{$FORM{$HTML_thankyou_field_name}};}
elsif ($_ eq $field_name_email){
if ($FORM{$field_name_email}){
my @mails = split(", ",$FORM{$field_name_email});
foreach(@mails){push @to, $SendTo{$_} if $SendTo{$_};}
}
}
elsif (($_ eq "required_fields") || ($_ eq "required_fields_numbers") || ($_ eq "required_fields_email")) { }
elsif ((in_array($_ ,@file_upload_fields)) && ($FORM{$_} ne ""))
{
my $fn = save_file($_,$file_dir);
$message .= "$_ : " unless $send_just_data;
$message .= "$file_URL/$fn\n";
$logText .= "$_ : " unless $data_only;
$logText .= "<a href=\"$file_URL/$fn\">$file_URL/$fn</a>\n";
}
else{
if ( !($kill_image_buttons_value && $_=~/(\.|\A)(x|y)\Z/) ) {
$message.="$_: " unless $send_just_data;
$message.="$FORM{$_}\n";
$logText.="$_: " unless $data_only;
$logText.="$FORM{$_}\n";
}
}

}
push @to, $to if $to && !@to;

my @checker = split(/[\r\n]/, $message);
my $line;
foreach $line(@checker)
{ if (($line =~ /^to:/i) || ($line =~ /^cc:/i) || ($line =~ /^bcc:/i) || ($line =~ /^from:/i) || ($line =~ /^reply-to:/i) || ($line =~ /Content-Type:/i)) {
error("use of reserved words to:, cc:, bcc: or reply-to: at line \"$line\"<br>");
}
}

if ($REMOTE_ADDR){
$message.="REMOTE_ADDR: " unless $send_just_data;
$message.="$ENV{REMOTE_ADDR}\n";
$logText.="REMOTE_ADDR: " unless $data_only;
$logText.="$ENV{REMOTE_ADDR}\n";
}
if ($HTTP_USER_AGENT){
$message.="HTTP_USER_AGENT: " unless $send_just_data;
$message.="$ENV{HTTP_USER_AGENT}\n";
$logText.="HTTP_USER_AGENT: " unless $data_only;
$logText.="$ENV{HTTP_USER_AGENT}\n";
}
if ($DATE){
$message.="DATE: " unless $send_just_data;
$message.="$date[2]:$date[1]:$date[0] $date\n";
$logText.="DATE: " unless $data_only;
$logText.="$date[2]:$date[1]:$date[0] $date\n";
}
error($sendToError) unless @to;
error($max_message_error) if length($message)>$max_message_length;

if($log){
$logText="To: ".join(", ", @to)."\nSubject: $subject\n".$logText;
$logText="$seperator\n".$logText if -f $log_name;
open (LOG, ">>$log_name") or error("Can't open log file");
print LOG $logText;
close LOG;
}

foreach(@to){
my $to = $_;
$to =~ s/\r//g; $from =~ s/\r//g; $subject =~ s/\r//g;
$to =~ s/\n//g; $from =~ s/\n//g; $subject =~ s/\n//g;
male("$to", "$from", $subject, $message);
}
if($auto_responder && $FORM{$from_field_name}){
$FORM{$from_field_name} =~ s/<([^>]|\n)*>//g;
$FORM{$from_field_name} =~ s/ //g;
$FORM{$from_field_name} =~ s/ //gs;
$FORM{$from_field_name} =~ s/\n|\r//gs;
open(F, "$auto_responder_message") or error("Can't open message file");
my @message=<F>;
close F;
male("$FORM{$from_field_name}","$auto_responder_from",$auto_responder_subject, join('',@message));

}

print "Location: $HTML_thankyou\n\n";
exit;

sub in_array {
(my $fieldname, my @uploadfields) = @_;

my $field;
foreach $field(@uploadfields)
{
if ($field eq $fieldname) {
return 1;
}
}
return 0;
}

sub error{
print "Content-type: text/html\n\n";
print "<html><head><title>Error</title></head><body><br><font color=$fontColor size=$fontSize face=$fontFace>$error_title<br><br>$_[0]<br>";
print "$return_message" if $_[1];
print "</font></body></html>";
exit;

}

sub save_file {
$file=param($_[0]);

$file =~m/([^\\\/]*\.\w*\Z)/i;
$filename=$1;
$filename=~m/.*\.(\w*\Z)/i;
$type = $1;
my $found=0;
foreach(@required_file_types){$found =1 if lc $_ eq lc $type}
error($error_file_type." for type $type") unless $found;
my $tmp_size =0;
if($rename_file){
$filename = $_[0]."_".int(rand(10000)).".".$type;
while(-e $filename){$filename = $_[0]."_".int(rand(10000)).".".$type;}
}
$filename =~ s/\s/_/g;
open(FILE,">$_[1]/$filename") || error("Can't save file $_[1]/$filename");
binmode FILE;
while ($bytesread=read($file,$buffer,1024)) {
print FILE $buffer;
$tmp_size+=1024;
if($max_size && $max_size<$tmp_size){
close FILE; unlink "$_[1]/$filename";
error("$error_max_size");
}
}
close(FILE);
return "$filename";
}

sub parse_cgi{

my %FORM = Vars;
@field = param;

foreach $key (keys %FORM) {
$FORM{$key} =~ s/%(..)/pack("c",hex($1))/ge;
$FORM{$key} =~ s/<!--(.|\n)*-->//g if $kill_html_tags;
$FORM{$key} =~ s/<([^>]|\n)*>//g if $kill_html_tags;
$FORM{$key} =~ s/\r//g;
}
return %FORM;
}



sub male{

if($send_via_SMTP){
$smtp = Net::SMTP->new($mailhost);

$smtp->mail($_[1]);
$smtp->to($_[0]);

$smtp->data();
$smtp->datasend("To: $_[0]\n");
$smtp->datasend("From: $_[1]\n");
$smtp->datasend("Subject: $_[2]\n\n");
$smtp->datasend("\n");
$smtp->datasend("$_[3]\n");
$smtp->dataend();

$smtp->quit;

}
else{
open(MAIL,"|$mailprog -t");
print MAIL "To: $_[0]\n";
print MAIL "From: $_[1]\n";
print MAIL "Subject: $_[2]\n\n";
print MAIL "$_[3]\n";
close(MAIL);
#print "To: $_[0]<br>";

}
}

sub test_form{
my $errors='';
foreach(@required_fields){
$errors.="ERROR FIELD &lt; $_ &gt;: $error_fields_require!<br>" if $FORM{$_} eq "";
}
foreach(@required_fields_numbers){
$errors.="ERROR FIELD &lt; $_ &gt;: $error_fields_numbers!<br>" if $FORM{$_}=~m/\D/ or $FORM{$_} eq '';
}
foreach(@required_fields_email){
$errors.="ERROR FIELD &lt; $_ &gt;: $error_fields_email!<br>" if $FORM{$_} !~m/\A\S+?\@\S+?\.\S+?\Z/;
}
foreach(keys(%FORM)){
if ( (uc($_) eq uc('to')) || (uc($_) eq uc('cc')) || (uc($_) eq uc('bcc'))|| (uc($_) eq uc('reply-to'))|| (uc($_) eq uc('from'))|| (uc($_) eq uc('Content-Type'))) {
$errors.="ERROR FIELD &lt; $_ &gt;: $error_fields_forbidden!<br>";
}
}
foreach (keys(%FORM)){
if (($FORM{$_} =~ /bcc:/i)||($FORM{$_} =~ /cc:/i)||($FORM{$_} =~ /from:/i)||($FORM{$_} =~ /reply-to:/i)||($FORM{$_} =~ /Content-Type:/i) ||($FORM{$_} =~ /to:/i)) {
$errors.="ERROR FIELD &lt; $_ &gt;: use of reserved words to:, cc:, bcc: or reply-to:!<br>";
}
}

my $http_user_agent = $ENV{HTTP_USER_AGENT};
$http_user_agent =~ s/[\s\n]//g;
if ($http_user_agent eq "") { $errors .= "ERROR : browser problem<br>";}
if ($http_user_agent =~ /Missigua/i) { $errors .= "ERROR : bad bot<br>";}

error("$errors",1) if $errors;


return;
}

sub html_text{
print "Content-type: text/html\n\n" unless $type;
print qq|<html>
<head>
<title>:: Admin Mode</title>
<style>
tr,td,body {font-family: Tahoma, Arial; font-size:10pt;}
.of {border-style:solid; border-width: 1; border-color : #999999; background-color:#dddddd}
.on {border-style:none;background-color:#ddeedd}
.off {border-style:none;background-color:#f3f3f3}
</style>
</head>
<body>
$_[0]
</body></html>|;
exit;

}
sub promt{
html_text(qq|
<br><br><br><br><center><form method=post action=$script_name>
<input type=hidden name=mode value=$admin_mode>
<table border=0 width=280>
<tr><th colspan=2 class=of>:: Admin mode</th></tr>
<tr class=on><td width=43% align=right>Login: </td>
<td width=57%><input type=text name=login size=13></td></tr>
<tr class=on><td align=right>Password: </td>
<td><input type=password name=password size=13></td></tr>
<tr class=on><td colspan=2 align=center><input type=submit></td></tr>
</table></form></center>|);
exit;
}
 
well, I'd start with the fact you are checking for any errors, you could be erroring out and never getting that far. I would be writing everything out to a log and trying to do it via CLI to see if sendmail is even getting everything it needs.


I would start with having use strict on every program. I see $mailprog being used on line 285 but don't see it being defined anywhere in the program. I know that using strict can be very hard at first but you will find the same recommendation from everyone that using strict is the only way to go.

~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
[noevil]
Travis - Those who say it cannot be done are usually interrupted by someone else doing it; Give the wrong symptoms, get the wrong solutions;
 
I second the recommendation if not insistence that you include use strict; and use warnings; at the beginning of every script. It will require adjustment of your programming style, but it will save you so much headache in the end and make it more likely that you'll get assistance in forums when you need it.

- Miller
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top