CGI/Perl Guide | Learning Center | Forums | Advertise | Login
Site Search: in

  Main Index MAIN
INDEX
Search Posts SEARCH
POSTS
Who's Online WHO'S
ONLINE
Log in LOG
IN

Home: Perl Programming Help: Advanced:
Almost there, just an error I don't know what it is about

 



Merlin
journeyman

Oct 10, 2000, 2:30 PM

Post #1 of 8 (3246 views)
Almost there, just an error I don't know what it is about Can't Post

I'm almost able to do my file uploading. I reverted to using Simon Tneoh's file uploading script but I'm getting an error I'm not sure what it is about (I may be a bit over my head with all this...). So, there's a call to a method called $fu->save_as($filename); and it returns the error "Bad file descriptor"; The whole script is the following (sorry if this is a bit long) with the save_as() sub giving the error :

package FileUpload;

use strict;
use IO::Handle;
use IO::File;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK);

require Exporter;
require AutoLoader;

@ISA = qw(Exporter AutoLoader);
@EXPORT = qw();
@EXPORT_OK = qw();

$VERSION = '0.04';

sub new {
my($pkg) = shift;
my($self) = {'_ufile' => shift};
my($fh) = new IO::Handle->fdopen(fileno($self->{'_ufile'}), "r");

$self->{'_fh'} = $fh;

$self->{'_deny_ext'} = [];

$self->{'_allow_char'} = ['\w', '\-', '\.'];

bless $self, $pkg;
}

sub _allow_char () { $_[0]->{'_allow_char'} }

sub _deny_ext () { $_[0]->{'_deny_ext'} }

sub allow_char (;@) {
return @{$_[0]->_allow_char} unless @_ > 1;
my($self) = shift;
push(@{$self->_allow_char}, @_);
$self->allow_char;
}

sub deny_ext (;@) {
return @{$_[0]->_deny_ext} unless @_ > 1;
my($self) = shift;
map { my($ext) = $_; $ext =~ s/^\.//g; push(@{$self->_deny_ext}, $ext) } @_;
$self->deny_ext;
}

sub fh () { $_[0]->{'_fh'} }

sub get_line () { $_[0]->fh->getline }

sub get_lines () { ($_[0]->fh->getlines) }

sub get_pos () { tell($_[0]->fh) }

sub is_filename_allowed ($) {
my($chars) = join("", @{$_[0]->_allow_char});
return ($_[1] =~ /^[$chars]+$/) ? 1 : 0;
}

sub is_ext_denied ($) {
my($exts) = join("|", @{$_[0]->_deny_ext});
return 1 if $_[1] =~ /\.($exts)$/i;
return 0;
}

sub orig_filename () {
my($path) = $_[0]->orig_filepath;
$path =~ s/^.*[\\\/]([^\\\/]+)$/$1/g;
return scalar($path);
}

sub orig_filepath () { scalar($_[0]->ufile) }

sub save () { $_[0]->save_as($_[0]->orig_filename) }

sub save_as ($) {
my($self) = shift;
my($newfilename) = shift;
my($currpos, $newfh, $buf, $total, $n, $n2);

$total = $n = $n2 = 0;
$buf = undef;
$newfh = undef;
$currpos = $self->get_pos;
$self->set_pos(0);

($! = 2, return 0) unless $newfilename;

($! = 22, return 0) if ($self->is_ext_denied($newfilename));
($! = 22, return 0) unless $self->is_filename_allowed($newfilename);

$newfh = new IO::File $newfilename, "w";
if ($^O =~ /Win32/) {
binmode($newfh);
binmode($self->fh);
}
return 0 unless $newfh;
while (($n = read($self->fh, $buf, 1024))) {
$n2 = syswrite($newfh, $buf, $n);
$total += $n2;
}
$newfh->close;
$self->set_pos($currpos);

return $total;
}

sub set_pos ($) { seek($_[0]->fh, $_[1], 0) }

sub size () { scalar((stat($_[0]->fh))[7]) }

sub ufile () { $_[0]->{'_ufile'} }

1;
__END__

Some more details : the server is running Perl 5.005_03 and RedHat 2.2.16 RAID. I'm trying to upload a jpg file from a win98 system. So, does anyone know what this "Bad file descriptor" is about?
The calls I'm making to the script are :
$fu = new FileUpload($objetcgi->param("image"));
@chararr = $fu->allow_char('\s\S'); # allow every type of caracters.
# Error trapping.
if (!($sizewritten = $fu->save_as("./images/$filename"))) {
print "Erreur de sauvegarde: $!";
}

Finally, I'm writing to dirs I created which are all 777. Thanks (if you're able to sort through this mess of a post!).


dws
Deleted

Oct 10, 2000, 3:05 PM

Post #2 of 8 (3246 views)
Re: Almost there, just an error I don't know what it is about [In reply to] Can't Post

How do you know that <BLOCKQUOTE><font size="1" face="Arial,Helvetica,sans serif">code:</font><HR>

my($fh) = new IO::Handle->fdopen(fileno($self->{'_ufile'}), "r");</pre><HR></BLOCKQUOTE> is suceeding?


Merlin
journeyman

Oct 10, 2000, 4:54 PM

Post #3 of 8 (3246 views)
Re: Almost there, just an error I don't know what it is about [In reply to] Can't Post

I guess that could be it. I tried some other forms of uploading and it seemed to be around the opening of a file on my computer that bugs appeared... Are there some issues I'm not aware of to be able to open a file on my computer for uploading? Special security that scripts tend to enforce? If I can go past that, I should be home free (and even use the simplified upload script from Anthony et al. from a couple of posts back). So, is there a way to find more specific errors about this to guide me (or my wonderful friends here...) Wink or to go over the errors I get? Much thanks!


dws
Deleted

Oct 11, 2000, 10:32 AM

Post #4 of 8 (3246 views)
Re: Almost there, just an error I don't know what it is about [In reply to] Can't Post

I just noticed that you're using fdopen(). Look it up, and compare it with open(). Then decide which one you need.


Merlin
journeyman

Oct 11, 2000, 5:28 PM

Post #5 of 8 (3246 views)
Re: Almost there, just an error I don't know what it is about [In reply to] Can't Post

Ok, I changed it to open() since the error was about a bad file descriptor, which is what fileno() was about. Now, I get another error :
Can't locate auto/IO/Handle/open.al in @INC

Does it seem there's a module missing from the Perl installation? The script is using IO::Handle and IO::File modules. Does anyone know if the missing open.al belongs to either one of those or to another one? If someone knows what this error leads to, lemme know. Thanks again!

p.s.: if someone is willing to write me or give me a working script to upload that's easy to use, I'd be eternally grateful. If you'd be able to help me get it running ok, I'd be doubly eternally grateful! Wink

[This message has been edited by Merlin (edited 10-11-2000).]


dws
Deleted

Oct 11, 2000, 9:44 PM

Post #6 of 8 (3246 views)
Re: Almost there, just an error I don't know what it is about [In reply to] Can't Post

You're too close to give up.

Hint: Does IO::Handle contain the implemention of open() that you need for opening a file, or is there perhaps a subclass of IO::Handle that has the right implementation.


[This message has been edited by dws (edited 10-11-2000).]


perlkid
stranger

Oct 12, 2000, 10:09 AM

Post #7 of 8 (3246 views)
Re: Almost there, just an error I don't know what it is about [In reply to] Can't Post

 
I had a lot of trouble with an uploading script that I was making today and yesturday, I always knew I would have to learn how to actually make an upload utility myself someday so I didn't have to rely on scripts I don't fully understand. Then when I was givin this script I learned that it's not all that difficult.

<BLOCKQUOTE><font size="1" face="Arial,Helvetica,sans serif">code:</font><HR>


#!/usr/local/bin/perl
#file: upload.pl

######################################################################
#Copyright 1998 David Turley (dturley@pobox.com>
#Last Modified April 30, 1998
#This script may not be resold or distributed without the author's
#express written permission.
#The current version of the script is available at
#http://www.pobox.com/~dturley/script.html
######################################################################

##################### DESCRIPTION ##############################
#This script allows users to upload files to a predetermined
#directory on your server. After a successful upload, email is
#sent to the adminstrator informing of an uploaded file.
#
#You must have the CGI.pm module installed. This module is distributed
#with recent Perl distributions. Info on the module can be found at:
# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html

######################## SETUP #################################
# Enter the correct values for these variables below:
#
# $mailTo -- This is the email address to which email notification of
# an upload will be sent.
#
# $upload_dir -- The directory where uploaded files will be saved.
#
# You may use either sendmail or the Net::SMTP module to send email:
# To use sendmail, set $use_sendmail = "yes",
# To use Net::SMTP module, set $use_sendmail = "no".
# $mail_path -- The path to your sendmail program.
# OR
# $mail_server -- Use this variable if you aren't using sendmail.
# Note: you can comment out the unused mail variable.
#
# %PASSWORDS -- Set names and paswords for valid users here. Be sure
# to follow proper syntax.
#
#
#Upload the script and set proper permissions for your server. There
#is no separate HTML form to upload. All forms are generated by this
#script. To access the upload form, enter the URL for the script in
#your web browser.

######################## BEGIN SETUP #################################
use CGI qw/:standard :html3/;
use Net::SMTP; ##comment out if not using

$mailTo = 'you@youremail.com';

$upload_dir = '/www/your/directory/';

$use_sendmail = 1; #set to 1 to use sendmail, 0 to use Net::SMTP module

$mail_path = '/usr/sbin/sendmail'; #for send_email1()

## OR ## ##you may comment out unused variable

$mail_server = 'pop.binary.net'; #for send_email2()

%PASSWORDS =
('some name' => 'pass',
'guest' => 'guest',
);

######################## END SETUP ##################################
print header,
start_html(-title=>'Upload File',-bgcolor=>'white'),

h1({-align=>CENTER},'File Upload Form');


if (param) {
check_password();
upload_file();
if ($use_sendmail) { send_email1(); }
else {send_email2();}
}

else {
print_form();
}

print hr;
print 'Upload script by ',
a({-href=>'http://www.pobox.com/~dturley/'},'David Turley');
print end_html;
exit(0);

################SUBROUTINES#################################
sub print_form {

print start_multipart_form(),
table(
TR({-align=>LEFT},
th('Enter Your Name: '),
td(textfield(-name=>'user',-size=>30))
),
TR({-align=>LEFT},
th('Enter Your Password: '),
td(textfield(-name=>'password',-size=>30))
),
TR({-align=>LEFT},
th('Enter a File to Upload: '),
td(filefield(-name=>'upload',-size=>50))
),
TR({-align=>LEFT},
th({-valign=>TOP},'Enter a Brief Description of the File: '),
td(textarea(-name=>'comment',-rows=>10,-cols=>50,-wrap=>physical))
),
TR({-align=>LEFT},
td({-colspan=>2,-align=>center},submit(-label=>'Upload File'))
)

),
end_form;
}

sub upload_file {
my $length;
my $size;
my $file = param('upload');
$file =~ m!([^/:\\]*)$!; #capture file name
my $short_name = $1;

if (!$file) {
print p({-align=>center},'You did not enter a file to upload.');

print p({-align=>center},a({-href=>url},'Go back and try again.'));
print end_html;
exit(0);
}

if (-e "$upload_dir/$short_name") {
print p({-align=>center},'The file name ',b($short_name), 'has already been used.',
'Please change the name of your local file and try again.');

print p({-align=>center},a({-href=>url},'Try Again.'));
print end_html;
exit(0);
}


open (SAVE,">$upload_dir/$short_name") &#0124; &#0124; die $!;
while ($size = read($file,$data,1024)) {
print SAVE $data;
$total_size += $size;
}
close SAVE;

if ($total_size > 0) { #file was transferred
print p('Your file has been uploaded. Here is the relevant information:');
print p(b('File Name: '),$file,br,b('File Size: '),$total_size);

print p(a({-href=>url},'Upload Another File'));
}

else { #nothing was uploaded
print p({-align=>center},'No file was transferred. ',
'Please be sure you entered a valid file name.');

print p({-align=>center},a({-href=>url},'Try Again.'));
print end_html;
unlink "$upload_dir/$short_name"; #get rid of file created by open
exit(0);
}


}


sub send_email1 {
my $user = param('user');
my $file = param('upload');
$file =~ m!([^/:\\]*)$!; #capture file name
my $short_name = $1;
my $comments = param('comment');

open (SENDMAIL, "| $mail_path -t") &#0124; &#0124; die $!;
print SENDMAIL "Subject: File Upload\n";
print SENDMAIL "From: $mailTo\n";
print SENDMAIL "To: $mailTo\n\n";
print SENDMAIL "A file has been uploaded to $upload_dir.\n";
print SENDMAIL "New Filename: $short_name\n";
print SENDMAIL "Size: $total_size\n";
print SENDMAIL "Uploaded by: $user\n";
print SENDMAIL "Comments:\n";
print SENDMAIL "$comments\n";
close (SENDMAIL);
}

sub send_email2 {
my $user = param('user');
my $file = param('upload');
$file =~ m!([^/:\\]*)$!; #capture file name
my $short_name = $1;
my $comments = param('comment');

$smtp = Net::SMTP->new($mail_server);
$smtp->mail($ENV{USER});
$smtp->to($mailTo);

$smtp->data();
$smtp->datasend("Subject: File Upload\n");
$smtp->datasend("From: $mailTo\n");
$smtp->datasend("To: $mailTo\n");
$smtp->datasend("\n");
$smtp->datasend("A file has been uploaded to $upload_dir.\n");
$smtp->datasend("New Filename: $short_name\n");
$smtp->datasend("Size: $total_size\n");
$smtp->datasend("Uploaded by: $user\n");
$smtp->datasend("Comments:\n");
$smtp->datasend("$comments\n");
$smtp->dataend();
$smtp->quit;
}


sub check_password {
my $user = param('user');
my $pass = param('password');
my $okay = 0;

foreach $key (keys %PASSWORDS) {
if (($key eq $user) && ($PASSWORDS{$key} eq $pass)) {
$okay = 1;
last;
}
}

if ($okay != 1) {
print p({-align=>center},'You must enter a valid name and password to use this script.');
print p({-align=>center},a({-href=>url},'Go back and try again.'));

print end_html;
exit(0);
}
}
</pre><HR></BLOCKQUOTE>

Just upload that whole file and the guy had a few extra things than I needed.

I looked at the upload sub routin and I now know what the trick is.

The biggist problem I had was the actuall form. I couldn't get any data at all from the users computer. Finally I went over everything and I found that I left out the form tag

ENCTYPE="multipart/form-data"

Then the browser must have understood to send the data, then everything worked. Usually I found the upload scripts to be really touchy.

But now I know that I can use them almost anywhere. Smile

Just sharing my mistakes and solutions.

I didn't really read any posts all the way through because I'm in a hurry, but I just had to share that with you.

perlkid


Merlin
journeyman

Oct 13, 2000, 4:11 PM

Post #8 of 8 (3246 views)
Re: Almost there, just an error I don't know what it is about [In reply to] Can't Post

Thanks for the info. I really think that the bug is the opening of the file at my end, on my computer. I tried another script using some standard file parsing and nothing's uploaded. I get, as I did numerous times before, a 0 bytes long file with the correct filename. I always knew I needed the enctype="multipart/form-data" form field and always used it. Does anyone know why the various scripts can't open the file on my computer? I turned off my BlackIce Defender just in case since it bloacked a lot of stuff I did on the net. Are there any calls I could make in the various scripts that could enlighten me as to why the failed upload? Thanks in advance.

p.s.: I'm using this script on a SSL server, could this have something to do with it?

[This message has been edited by Merlin (edited 10-13-2000).]

 
 


Search for (options) Powered by Gossamer Forum v.1.2.0

Web Applications & Managed Hosting Powered by Gossamer Threads
Visit our Mailing List Archives