Beefy Boxes and Bandwidth Generously Provided by pair Networks
Don't ask to ask, just ask
 
PerlMonks  

Re: Problem with uploading file

by Siddartha (Curate)
on Aug 15, 2001 at 17:48 UTC ( #105042=note: print w/ replies, xml ) Need Help??


in reply to Problem with uploading file

Thanks for replying tachyon

When I use the default encoding type with startform() it works, but as soon as I change it to 'multitype/form-data', it doesn't any more.

I know it shouldn't make a differance but it does. I have updated my CGI module to 2.77 just in case there was a bug, but it still doesn't work.

Basically all the name value pairs I read gets passed when using the default encoding type but not when I change it.

Anyway, here is the code:

login.cgi

#!/usr/bin/perl use CGI; $| = 1; $query = CGI::new(); $passfile = "/*****/***.cfg"; $dir = "/Volumes/*****/pdf/magazines/"; $menu = $query->param("menu"); $name = $query->param("name"); $password = $query->param("password"); $rights = ''; if (!(defined($menu))) { if (!(defined($name))) { print $query->redirect('pdf_login.cgi'); }; my $cookie_name = $query->cookie("name"); if ($cookie_name ne $name) { my $cookie = $query->cookie (-name => 'name', -value => $name, -expires => '+10y'); print $query->redirect (-cookie => $cookie, -uri => $query->se +lf_url()); exit 0; }; } else { my $cookie_name = $query->cookie("name"); $name = $cookie_name; }; my $cookie_pass = $query->cookie("pass"); open (IN, "$passfile") || die "Can't open $passfile for appending!\n"; my $readname = ""; while (<IN>) { ($readname,$pass,$right) = split(/:/); if ($name eq $readname) { $mypass = $pass; if ($cookie_pass eq $pass) { $rights = $right; } else { if (crypt($password,$pass) eq $pass) { $rights = $right; } else { print $query->header(); print "<HTML>\n<HEAD>\n<TITLE></TITLE>\n"; print " </HEAD>\n <META HTTP-EQUIV=\"Refresh\" CONTENT=\"2;URL=pdf_login +.cgi\"> <BODY MARGINHEIGHT=0 MARGINWIDTH=0 LEFTMARGIN=0 TOPMAR +GIN=0 BGCOLOR=\"FFFFFF\"> "; print " <TABLE WIDTH=\"100%\" BORDER=0 CELL +PADDING=0 CELLSPACING=0>\n <TR>\n <TD>\n </TD>\n <TD> <IMG SRC=\"../pdf/images/ba2.jpg\" ALIGN='RIGH +T' WIDTH=201 HEIGHT=78></TD> </TR>\n <TR>\n <TD COLSPAN=2>\n"; print "<FONT SIZE=3 FACE=\"ARIAL\"> <CENTER> <BR><BR> <BR>Wrong Password<BR><BR></CENTER>"; print " </TD>\n </TR>\n </TABLE>\n </BODY>\n </HTML>\n "; exit 0; }; # end else }; #end else }; #end if print $readname; }; #end while if ($rights eq "") { print $query->header(); print "<HTML>\n<HEAD>\n<TITLE></TITLE>\n "; print " </HEAD>\n <META HTTP-EQUIV=\"Refresh\" CONTENT=\"2;URL=pdf_login +.cgi\"> <BODY MARGINHEIGHT=0 MARGINWIDTH=0 LEFTMARGIN=0 TOPMAR +GIN=0 BGCOLOR=\"FFFFFF\"> "; print " <TABLE WIDTH=\"100%\" BORDER=0 CELL +PADDING=0 CELLSPACING=0>\n <TR>\n <TD>\n </TD>\n <TD> <IMG SRC=\"../pdf/images/ba2.jpg\" ALIGN='RIGH +T' WIDTH=201 HEIGHT=78></TD> </TR>\n <TR>\n <TD COLSPAN=2>\n"; print "<FONT SIZE=3 FACE=\"ARIAL\"> <CENTER> <BR><BR>Please log in with an approved username.<BR>< +BR><BR></CENTER>"; print " </TD>\n </TR>\n </TABLE>\n </BODY>\n </HTML>\n "; exit 0; }; close (IN); if (((defined $password)) and ($cookie_pass ne crypt($password,$my +pass))) { my $cookie = $query->cookie (-name => 'pass', -value => crypt($password,$mypass)); print $query->redirect (-cookie => $cookie, -uri => $query->se +lf_url()); exit 0; }; print "Cache-Control: no-cache\nPragma: no-cache\n"; print $query->header(); print "<HTML>\n<HEAD>\n<TITLE></TITLE>\n"; print " </HEAD>\n <BODY MARGINHEIGHT=0 MARGINWIDTH=0 LEFTMARGIN=0 TOPMAR +GIN=0 BGCOLOR=\"FFFFFF\"> "; print " <TABLE WIDTH=\"100%\" BORDER=0 CELLPADDING= +0 CELLSPACING=0>\n <TR>\n <TD>\n </TD>\n <TD> <IMG SRC=\"../pdf/images/ba2.jpg\" ALIGN='RIGH +T' WIDTH=201 HEIGHT=78></TD> </TR>\n <TR>\n <TD COLSPAN=2>\n <CENTER><BR><BR>Welcome $name.<BR><BR></CENTER +>\n <CENTER><TABLE BGCOLOR='#EEEEEE' BORDER=1 CELL +PADDING=5 CELLSPACING=5>\n <TR>\n"; if ($rights eq "A\n") { &outputA; }; if ($rights eq "C\n") { &outputC; }; if ($rights eq "AC\n") { &outputA; &outputC; }; if ($rights eq "ACU\n") { &outputA; &outputC; &outputU; }; print " </TR></TABLE></CENTER>\n </TD>\n </TR>\n </TABLE>\n </BODY>\n </HTML>\n "; exit 0; sub outputA { print "<TD><FONT SIZE=3 FACE=\"ARIAL\"> <CENTER> <BR> Choose a date to approve: <BR><BR>"; opendir(DIR, $dir) or die "Can not opendir $dir"; @mags = grep !/^\.\.?$/, readdir(DIR); closedir(DIR); foreach $magazine (@mags) { print "<HR><BR><CENTER>$magazine</CENTER><BR><BR> +"; opendir(DIR, "$dir/$magazine") or die "Can not o +pendir $dir/$magazine"; @files = grep { /^\d+$/ } readdir(DIR); closedir(DIR); foreach $filename (@files) { @months = ('January','February','March','April','May', +'June','July', 'August','September','October','November','Decemb +er'); $month = int substr($filename,4); $mfilename = $months[$month-1]." ".substr($filename,0,4 +); print "<A HREF= \"pdf.cgi?mag=$magazine&month +=$filename\" TARGET=\"_self\">$mfilename</A><BR><BR>\n"; }; }; print "<HR></CENTER></TD>"; }; sub outputC { print "<TD><FONT SIZE=3 FACE=\"ARIAL\"> <CENTER> <BR>View submitted comments:<BR><BR>\n"; opendir(DIR, $dir) or die "Can not opendir $dir"; @mags = grep !/^\.\.?$/, readdir(DIR); closedir(DIR); foreach $magazine (@mags) { print "<HR><BR><CENTER>$magazine</CENTER><BR><BR> +"; opendir(DIR, "$dir/$magazine") or die "Can not o +pendir $dir/$magazine"; @files = grep { /^\d+$/ } readdir(DIR); closedir(DIR); foreach $filename (@files) { @months = ('January','February','March','April','May','Jun +e','July', 'August','September','October','November','Decemb +er'); $month = int substr($filename,4); $mfilename = $months[$month-1]." ".substr($filename,0,4 +); print "<A HREF= \"pdf3.cgi?mag=$magazine&mont +h=$filename\" TARGET=\"_self\">$mfilename</A><BR><BR>\n"; }; }; print "<HR></CENTER></TD>"; }; sub outputU { print "<TD><FONT SIZE=3 FACE=\"ARIAL\"> <CENTER> <BR>Upload Files:<BR><HR>\n"; print $query->start_form('POST','upload.cgi','multipa +rt/form-data'); opendir(DIR, $dir) or die "Can not opendir $dir"; @mags = grep !/^\.\.?$/, readdir(DIR); closedir(DIR); print "<BR><b>Magazine:</b><BR>"; print $query->popup_menu(-name=>'magazine', -values=>[@mags]); print "<BR><BR><b>Edition:</b><BR>"; @months = ('January','February','March','April','May' +,'June','July', 'August','September','October','November','Decemb +er'); print $query->popup_menu(-name=>'month', -values=>[@months]); print "<BR><BR><b>Year:</b><BR>"; print $query->textfield('year','2001',4) . "\n"; print "<BR><BR><b>File to upload:</b><BR>"; print $query->filefield('upload_file','',30,80); print "<CENTER>"; print $query->submit("Upload"); print "</CENTER><BR>\n\n"; print $query->endform(); print "<HR></CENTER></TD>"; };

I know it is not the cleanest or best way to do it, lots of repetition, but bare with me.

And here is upload.cgi:

#!/usr/bin/perl use CGI qw/:standard/; $| = 1; $query = new CGI; $month = $query->param("month"); $year = $query->param("year"); $magazine = $query->param("magazine"); %months = ('January','01','February','02','March','03','April','04', +'May','05','June','06','July','07', 'August','08','September','09','October','10','No +vember',11,'December','12'); my $mymonth = $year . $months{$month}; my $dir = "/Volumes/*****/pdf/magazines/$magazine/$mymonth"; my $name = $query->cookie("name"); if (!(defined($name)) or ($name eq '')) { print $query->redirect('pdf_login.cgi'); } else { print $query->header(); print "<HTML>\n<HEAD>\n<TITLE>$name</TITLE>\n"; print " </HEAD>\n <BODY MARGINHEIGHT=0 MARGINWIDTH=0 LEFTMARGIN=0 TOPMARGIN=0 BGCOLOR=\" +FFFFFF\"> <FONT SIZE=3 FACE=\"ARIAL\"> "; my $bytes_read=0; my $size=''; my $buff=''; my $filename=''; my $write_file=''; my $filepath=''; $filepath=$query->param("upload_file"); if ($filepath =~ /([^\/\\]+)$/) { $filename="$1"; } else { $filename="$filepath"; } $write_file="$dir" . "/" . "$filename"; print "$dir,$mymonth,$month,$magazine,$name,$filepath<BR>\n"; print "Filename=$filename<br>\n"; print "Writefile= $write_file<br>\n"; if (!open(WFD,">>$write_file")) { die("Error opening $write_file for writing"); return; } while ($bytes_read=read($filepath,$buff,1024)) { binmode WFD; print WFD $buff; } close(WFD); if ((stat $write_file)[7] <= 0) { unlink($write_file); die("Could not upload file: $filename"); return; } else { print<<EOF; <center> <hr noshade size=1 width="90%"> <table border=0 bgcolor="#c0c0c0" cellpadding=0 cellspacing=0> <tr> <td> <table border=0 width="100%" cellpadding=10 cellspacin +g=2> <tr align="center"> <td bgcolor="#000099" width="100%"> <font color="#ffffff"> File <font color="#00ffff"><b>$filename</b></font> +of size <font color="#00ffff"><b>$size</b></font> byte +s is uploaded successfully! </font> </td> </tr> </table> </td> </tr> </table> </center> EOF ; } print " </BODY>\n </HTML>\n "; }; exit 0;

I really hope I just did something stupid.

Thanks for your help

-Siddartha


Comment on Re: Problem with uploading file
Select or Download Code
Re: Re: Problem with uploading file
by tachyon (Chancellor) on Aug 15, 2001 at 18:25 UTC

    First thing I can see is that you ask CGI.pm for the function interface via the use CGI qw(:standard) but then go on to use the OO methods. Change to just use CGI; and see if that fixes it. If it does report the bug!

    cheers

    tachyon

    s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

      No it doesn't fix it.

      -Siddartha

        OK time for some lower level debugging. To check that the info is coming through to your upload script OK replace it with this:

        #!/usr/bin/perl read(STDIN,$buf,$ENV{'CONTENT_LENGTH'}); print "Content-Type: text/html\n\n"; print $buf;

        This will print the raw post data to screen. You should see something like

        blah blah ..... ------------------------2325446af455 name1 value1 ------------------------2325446af455 name2 value2 ------------------------2325446af455 ....

        This is how the raw data is sent when you use form encoding. The --xxx is the boundary. Anyway you should be able to see your form data (name/value pairs) plain as day. If it is there then CGI.pm would seem broken, if not it is your form.

        cheers

        tachyon

        s&&rsenoyhcatreve&&&s&n.+t&"$'$`$\"$\&"&ee&&y&srve&&d&&print

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: note [id://105042]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (14)
As of 2014-10-21 11:33 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    For retirement, I am banking on:










    Results (102 votes), past polls