[24440] in Perl-Users-Digest
Perl-Users Digest, Issue: 6624 Volume: 10
daemon@ATHENA.MIT.EDU (Perl-Users Digest)
Sat May 29 06:05:43 2004
Date: Sat, 29 May 2004 03:05:05 -0700 (PDT)
From: Perl-Users Digest <Perl-Users-Request@ruby.OCE.ORST.EDU>
To: Perl-Users@ruby.OCE.ORST.EDU (Perl-Users Digest)
Perl-Users Digest Sat, 29 May 2004 Volume: 10 Number: 6624
Today's topics:
Re: 2 naive questions: Perl 6; Perl vs. shell scripts <me@privacy.net>
best way to eliminate a row in a multidimensional array (Jack)
Re: best way to eliminate a row in a multidimensional a <uri@stemsystems.com>
Re: best way to eliminate a row in a multidimensional a <tore@aursand.no>
Re: best way to eliminate a row in a multidimensional a <tassilo.parseval@rwth-aachen.de>
file read/write synchronization: advice needed (Junpei)
Re: file read/write synchronization: advice needed <usenet@morrow.me.uk>
Re: Listing files sorted by creation time <krahnj@acm.org>
Re: MyPAN? <uri@stemsystems.com>
Re: On "for (@foo)" <jgibson@mail.arc.nasa.gov>
Re: On "for (@foo)" (Anno Siegel)
Perl to c <xuxu_18@yahoo.com>
Re: Perl to c <ewijaya@singnet.com.sg>
regexp hangs script <norfernuman@yahoo.com>
Re: regexp hangs script <noreply@gunnar.cc>
Re: regexp hangs script <norfernuman@yahoo.com>
Re: regexp hangs script <tore@aursand.no>
Re: Two quick questions about Perl6 <uri@stemsystems.com>
Re: Why is this upload script not working (Mark Constant)
Re: Why is this upload script not working <sbryce@scottbryce.com>
Re: Why is this upload script not working <ebohlman@omsdev.com>
Re: Why is this upload script not working <noreply@gunnar.cc>
Re: Why is this upload script not working <usenet@morrow.me.uk>
Digest Administrivia (Last modified: 6 Apr 01) (Perl-Users-Digest Admin)
----------------------------------------------------------------------
Date: Sat, 29 May 2004 20:01:23 +1200
From: "Tintin" <me@privacy.net>
Subject: Re: 2 naive questions: Perl 6; Perl vs. shell scripts
Message-Id: <2hqub8Ffrp4iU1@uni-berlin.de>
"J Krugman" <jkrugman345@yahbitoo.com> wrote in message
news:c97s73$n9v$1@reader2.panix.com...
>
> The second question is: given how much more powerful Perl scripting
> is compared to (Unix) shell scripting, I'm surprised that there's
> so much shell scripting still out there. Is there any hope that
> Perl scripts will replace 95% of the shell scripting out there?
> Or are all these shell scripts going to be with us forever, just
> like COBOL?
Right tool for the right job. It pains me when people write a 20 line Perl
program that is essentially:
system("command");
system("another command");
When it can be done elegantly in a 4 line shell script.
------------------------------
Date: 28 May 2004 22:52:21 -0700
From: jack_posemsky@yahoo.com (Jack)
Subject: best way to eliminate a row in a multidimensional array
Message-Id: <209b7e58.0405282152.3d6af6d2@posting.google.com>
Hi I want to take out an entire row of a multidim array (everything
about it) and have the row below "assume" the row and index numbers
(and any other subsequent rows also would move up 1 with their
indices)..
Also, I am looking for a good way to count the number of rows in a
given multidim array..
Curious how this can be done.
Thank you,
Jack
------------------------------
Date: Sat, 29 May 2004 06:40:47 GMT
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: best way to eliminate a row in a multidimensional array
Message-Id: <x74qpzd9cg.fsf@mail.sysarch.com>
perldoc -f slice
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
------------------------------
Date: Sat, 29 May 2004 08:53:35 +0200
From: Tore Aursand <tore@aursand.no>
Subject: Re: best way to eliminate a row in a multidimensional array
Message-Id: <pan.2004.05.29.06.53.23.516388@aursand.no>
On Fri, 28 May 2004 22:52:21 -0700, Jack wrote:
> Hi I want to take out an entire row of a multidim array (everything
> about it) and have the row below "assume" the row and index numbers
> (and any other subsequent rows also would move up 1 with their
> indices)..
What have you tried so far? What didn't work? How about something like
the code below?
sub remove_array_element {
my $array = shift;
my $index = shift || 0;
my @array = ();
for ( 0..$#$array ) {
push( @array, $array->[$_] ) unless ( $_ == $index );
}
return \@array;
}
--
Tore Aursand <tore@aursand.no>
"Have you ever had a dream, Neo, that you were so sure was real? What
if you were unable to wake from that dream? How would you know the
difference between the dream world and the real world?" (Morpheus, The
Matrix)
------------------------------
Date: Sat, 29 May 2004 09:31:17 +0200
From: "Tassilo v. Parseval" <tassilo.parseval@rwth-aachen.de>
Subject: Re: best way to eliminate a row in a multidimensional array
Message-Id: <2hqsi8Fftt6rU1@uni-berlin.de>
Also sprach Uri Guttman:
> perldoc -f slice
'perldoc -f splice' actually.
Tassilo
--
$_=q#",}])!JAPH!qq(tsuJ[{@"tnirp}3..0}_$;//::niam/s~=)]3[))_$-3(rellac(=_$({
pam{rekcahbus})(rekcah{lrePbus})(lreP{rehtonabus})!JAPH!qq(rehtona{tsuJbus#;
$_=reverse,s+(?<=sub).+q#q!'"qq.\t$&."'!#+sexisexiixesixeseg;y~\n~~dddd;eval
------------------------------
Date: 29 May 2004 02:46:23 -0700
From: qcg2222@yahoo.com (Junpei)
Subject: file read/write synchronization: advice needed
Message-Id: <a1cc2e8.0405290146.1362bd98@posting.google.com>
problem: I have a program A that writes (overwrite) to a file 5
times/second (the results of a realtime calculation); i want several
other programs B through E to occasionally read that file to see what
the current results are (I only need the current results). how do i
keep the programs B to E from trying to read while program A is
writing? or is there a better solution than writing to a file? hoping
for an easy solution... i'm on linux.
thanks in advance,
Junpei
------------------------------
Date: Sat, 29 May 2004 09:51:21 +0000 (UTC)
From: Ben Morrow <usenet@morrow.me.uk>
Subject: Re: file read/write synchronization: advice needed
Message-Id: <c99mep$50i$2@wisteria.csv.warwick.ac.uk>
Quoth qcg2222@yahoo.com (Junpei):
> problem: I have a program A that writes (overwrite) to a file 5
> times/second (the results of a realtime calculation); i want several
> other programs B through E to occasionally read that file to see what
> the current results are (I only need the current results). how do i
> keep the programs B to E from trying to read while program A is
> writing? or is there a better solution than writing to a file? hoping
> for an easy solution... i'm on linux.
perldoc -f flock
Ben
--
I've seen things you people wouldn't believe: attack ships on fire off
the shoulder of Orion; I watched C-beams glitter in the dark near the
Tannhauser Gate. All these moments will be lost, in time, like tears in rain.
Time to die. ben@morrow.me.uk
------------------------------
Date: Fri, 28 May 2004 23:22:00 GMT
From: "John W. Krahn" <krahnj@acm.org>
Subject: Re: Listing files sorted by creation time
Message-Id: <40B7C994.74FC6E93@acm.org>
Jim Gibson wrote:
>
> In article <40B6793D.DDFF2C95@acm.org>, John W. Krahn <krahnj@acm.org>
> wrote:
>
> > Jim Gibson wrote:
> > >
> > > On unix, you can do:
> > >
> > > my @files = `cd /mydir;ls -t *.txt`;
> > ^^^^^^^^^
> > You are changing the directory in a different process which means that
> > the list of file names returned will not be available from the current
> > directory and you didn't chomp the list so every file name will have a
> > newline at the end.
>
> True, the above just gives you the file names. If you want the full
> path name for the files you can do instead:
>
> my @files = `ls -t /mydir/*.txt'
I think you meant:
chomp( my @files = `ls -t /mydir/*.txt` );
John
--
use Perl;
program
fulfillment
------------------------------
Date: Fri, 28 May 2004 22:38:23 GMT
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: MyPAN?
Message-Id: <x7pt8och41.fsf@mail.sysarch.com>
>>>>> "VR" == Vetle Roeim <vetro@online.no> writes:
>> Many thanks, Randal.
VR> Indeed, but I refuse to believe he's only one man... The name is
VR> obviously a pseudonym for a large group of genious Perl-hackers
VR> churning out articles and books! ;)
well, his irc and email id are merlyn :)
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
------------------------------
Date: Fri, 28 May 2004 16:51:05 -0700
From: Jim Gibson <jgibson@mail.arc.nasa.gov>
Subject: Re: On "for (@foo)"
Message-Id: <280520041651051622%jgibson@mail.arc.nasa.gov>
In article <20040528140443.P18263@dishwasher.cs.rpi.edu>, Paul Lalli
<ittyspam@yahoo.com> wrote:
> On Fri, 28 May 2004, Jim Gibson wrote:
>
> > In article <c96vkq$kkk$1@wisteria.csv.warwick.ac.uk>, Ben Morrow
> > <usenet@morrow.me.uk> wrote:
> >
> > > You never need C-style loops:
> > >
> > > for my $i (0..$#X) {
> > > $X[$i] = 0;
> > > }
> > >
> > > Ben
> >
> > You do if you want to skip some elements:
> >
> > Jim 53% cat loops.pl
> > #!/usr/local/bin/perl
> > use strict;
> > use warnings;
> >
> > my @array = ( 0..4 );
> >
> > print "C-style:\n";
> > for( my $i = 0; $i < @array; $i++ ) {
> > print "$i. $array[$i]\n";
> > $i++ if $i == 2;
> > }
> >
> > print "Perlish:\n";
> > for my $i ( 0 .. $#array ) {
> > print "$i. $array[$i]\n";
> > $i++ if $i == 2;
> > }
>
> Ew. Why would you ever do that? In either of those loops? Incrementing
> the count variable within a Cstyle loop is just terrible.
I guess I should have said "You do if you want to skip an element based
on a test of the previous element." That is what is being demonstrated
in the above loops. And for that case, a next will not work.
Why would you want to do that? Well I do this all the time in
command-line processing, for one example. I want to have a switch '-o'
that will cause output to be written to a file. The name of the file
has a default, primarily for testing. When I actually use the program,
I want to specify the output file. So if the -o switch is followed by
another option that doesn't start with a dash, I use it as the output
file name. As far as I know, this case is not covered by the Getopt
modules.
Here is a short program demonstrating this technique. If anyone has a
better way of doing this, please post it.
Jim 52% cat showopts.pl
#!/usr/local/bin/perl
use strict;
use warnings;
my $debug = 0;
my $output = 0;
my $output_file = 'default.out';
for( my $i = 0; $i < @ARGV; $i++ ) {
my $arg = $ARGV[$i];
if( $arg eq '-d' ) {
$debug = 1;
}elsif( $arg eq '-o' ) {
$output = 1;
if( $i < $#ARGV && $ARGV[$i+1] !~ /^-/ ) {
$output_file = $ARGV[++$i];
}
}
}
print "Debug mode is on\n" if $debug;
print "Output will be written to file $output_file\n" if $output;
Jim 53% showopts.pl
Jim 54% showopts.pl -d
Debug mode is on
Jim 55% showopts.pl -o
Output will be written to file default.out
Jim 56% showopts.pl -o -d
Debug mode is on
Output will be written to file default.out
Jim 57% showopts.pl -o test.out -d
Debug mode is on
Output will be written to file test.out
Jim 58% showopts.pl -d -o test.out
Debug mode is on
Output will be written to file test.out
Regardless of whether you like this method or not, it does demonstrate
that the loops 'for( my $i = 0; $i < @array; $i++ )' and 'for my $i ( 0
.. $#array)' and not exactly equivalent, unless you are genetically
indisposed to changing a loop variable inside the loop. :)
[ snip one loop ]
> for my $i (0..$#array){
> next if $i == 2;
> print "$i, $array[$i]\n";
> }
I suppose I could set a flag when finding th '-o' and then take the
next argument as the file name if the flag is set and the option
doesn't start with a dash, but that seems a bit convoluted just to
avoid incrementing the loop variable.
>
> Paul Lalli
Thanks for your comments (and thanks to Ben and Brian, as well).
------------------------------
Date: 29 May 2004 06:01:41 GMT
From: anno4000@lublin.zrz.tu-berlin.de (Anno Siegel)
Subject: Re: On "for (@foo)"
Message-Id: <c99905$p4i$1@mamenchi.zrz.TU-Berlin.DE>
Jim Gibson <jgibson@mail.arc.nasa.gov> wrote in comp.lang.perl.misc:
> In article <20040528140443.P18263@dishwasher.cs.rpi.edu>, Paul Lalli
> <ittyspam@yahoo.com> wrote:
> > On Fri, 28 May 2004, Jim Gibson wrote:
> > > In article <c96vkq$kkk$1@wisteria.csv.warwick.ac.uk>, Ben Morrow
> > > <usenet@morrow.me.uk> wrote:
> > > > You never need C-style loops:
[...]
> > > You do if you want to skip some elements:
[...]
> Here is a short program demonstrating this technique. If anyone has a
> better way of doing this, please post it.
>
> Jim 52% cat showopts.pl
> #!/usr/local/bin/perl
> use strict;
> use warnings;
>
> my $debug = 0;
> my $output = 0;
> my $output_file = 'default.out';
>
> for( my $i = 0; $i < @ARGV; $i++ ) {
> my $arg = $ARGV[$i];
> if( $arg eq '-d' ) {
> $debug = 1;
> }elsif( $arg eq '-o' ) {
> $output = 1;
> if( $i < $#ARGV && $ARGV[$i+1] !~ /^-/ ) {
> $output_file = $ARGV[++$i];
> }
> }
> }
A while-loop works just as well without indexing:
while ( @ARGV ) {
my $arg = shift;
if( $arg eq '-d' ) {
$debug = 1;
} elsif ( $arg eq '-o' ) {
$output = 1;
if ( @ARGV && $ARGV[ 0] ) {
$output_file = shift;
}
}
}
Anno
------------------------------
Date: Fri, 28 May 2004 22:44:58 -0400
From: "Profetas" <xuxu_18@yahoo.com>
Subject: Perl to c
Message-Id: <064b3921dee137caa53204f45561c62a@localhost.talkaboutprogramming.com>
Is there any perl to c converter?
Thanks
------------------------------
Date: Sat, 29 May 2004 11:59:01 +0800
From: "Edward Wijaya" <ewijaya@singnet.com.sg>
Subject: Re: Perl to c
Message-Id: <opr8qtcnuepncm2o@news.singnet.com.sg>
On Fri, 28 May 2004 22:44:58 -0400, Profetas <xuxu_18@yahoo.com> wrote:
Read this ;-)
http://www.perl.com/pub/a/2001/06/27/ctoperl.html
Regards
Edward WIJAYA
SINGAPORE
------------------------------
Date: Sat, 29 May 2004 00:35:29 GMT
From: norfernuman <norfernuman@yahoo.com>
Subject: regexp hangs script
Message-Id: <lVQtc.1$Qn1.0@newssvr27.news.prodigy.com>
I'm trying to clean off a few characters from the beginning of a string.
I must be looking right at the problem, and not seeing it.
I prepended the names of my form elements so I could group them at print
out. The prepended flags match the values in my @form_flags array.
I want to clean off the flags before printout. If I leave out the
substitution it works fine.
I don't get any errors, it runs without errors from the cmd line, but it
hangs from a browser.
Thanks for any help.
- NN
Here's my code:...
my @form_flags = qw(gen_ int_ kit_ bed_ ext_ loc_ utl_);
foreach my $flag (@form_flags) {
foreach $_ ($q->param()) {
if ( $_ =~ /(^\w+_)/ ) {
if ( $1 eq $flag ) {
s/^\w+_//g; #### this make script hang
print "$_ : " . $q->param($_) . "<p>\n";
}
}
}
}
------------------------------
Date: Sat, 29 May 2004 03:34:09 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: regexp hangs script
Message-Id: <2hq7r5Fflor1U1@uni-berlin.de>
norfernuman wrote:
> I prepended the names of my form elements so I could group them at
> print out. The prepended flags match the values in my @form_flags
> array. I want to clean off the flags before printout. If I leave
> out the substitution it works fine.
>
> I don't get any errors, it runs without errors from the cmd line,
> but it hangs from a browser.
I don't know why it hangs for you, but I know that you cannot alter
the keys all through the CGI object that way.
> my @form_flags = qw(gen_ int_ kit_ bed_ ext_ loc_ utl_);
>
> foreach my $flag (@form_flags) {
>
> foreach $_ ($q->param()) {
> if ( $_ =~ /(^\w+_)/ ) {
> if ( $1 eq $flag ) {
> s/^\w+_//g; #### this make script hang
> print "$_ : " . $q->param($_) . "<p>\n";
To print the values, you need to say for instance:
print "$_ : " . $q->param("$flag$_") . "<p>\n";
but maybe something like this would make more sense:
if ( $1 eq $flag ) {
my ($shortkey) = /^\w+_(.+)/;
print "$shortkey : " . $q->param($_) . "<p>\n";
}
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Sat, 29 May 2004 01:54:18 GMT
From: norfernuman <norfernuman@yahoo.com>
Subject: Re: regexp hangs script
Message-Id: <e3Stc.43$HZ1.21@newssvr27.news.prodigy.com>
norfernuman wrote:
> I'm trying to clean off a few characters from the beginning of a string.
> I must be looking right at the problem, and not seeing it.
>
> I prepended the names of my form elements so I could group them at print
> out. The prepended flags match the values in my @form_flags array.
> I want to clean off the flags before printout. If I leave out the
> substitution it works fine.
>
> I don't get any errors, it runs without errors from the cmd line, but it
> hangs from a browser.
>
> Thanks for any help.
>
> - NN
>
> Here's my code:...
>
> my @form_flags = qw(gen_ int_ kit_ bed_ ext_ loc_ utl_);
>
> foreach my $flag (@form_flags) {
>
> foreach $_ ($q->param()) {
> if ( $_ =~ /(^\w+_)/ ) {
> if ( $1 eq $flag ) {
> s/^\w+_//g; #### this make script hang
> print "$_ : " . $q->param($_) . "<p>\n";
> }
> }
> }
>
> }
Come to find out, on closing the browser (Mozilla 1.7b) and coming back
to it later, the code worked. It must have been a cache problem. (duh)
Back and forth from form to display.
Although this line would not have worked:
>s/^\w+_//g;
>print "$_ : " . $q->param($_) . "<p>\n";
because param($_) now did not match the original param name.
now...
my $old_val = $_;
s/^\w+_//g;
print "$_ : " . $q->param($old_val) . "<p>\n";
I get the nice clean name I wanted to display.
- NN
------------------------------
Date: Sat, 29 May 2004 06:42:00 +0200
From: Tore Aursand <tore@aursand.no>
Subject: Re: regexp hangs script
Message-Id: <pan.2004.05.29.04.23.14.483982@aursand.no>
On Sat, 29 May 2004 00:35:29 +0000, norfernuman wrote:
> foreach my $flag (@form_flags) {
>
> foreach $_ ($q->param()) {
> if ( $_ =~ /(^\w+_)/ ) {
> if ( $1 eq $flag ) {
> s/^\w+_//g; #### this make script hang
> print "$_ : " . $q->param($_) . "<p>\n";
> }
> }
> }
>
> }
Don't set the $_ variable. Let Perl itself take care of that;
foreach my $flag ( @form_flags ) {
foreach ( $q->param() ) {
if ( /(^\w+_)/ ) {
if ( $1 eq $flag ) {
s/^\w+_//g;
print "$_ : " . $q->param( $_ ) . "<p>\n";
}
}
}
}
--
Tore Aursand <tore@aursand.no>
"I know not with what weapons World War 3 will be fought, but World War
4 will be fought with sticks and stones." (Albert Einstein)
------------------------------
Date: Fri, 28 May 2004 22:43:09 GMT
From: Uri Guttman <uri@stemsystems.com>
Subject: Re: Two quick questions about Perl6
Message-Id: <x7n03scgw2.fsf@mail.sysarch.com>
>>>>> "MD" == Michele Dondi <bik.mido@tiscalinet.it> writes:
MD> (1) Don't you think that whereas the new language will indeed be more
MD> consistent and robust, it will also be *slightly* less magic?
not really. it is still perl in many ways. read the apocalypses,
exegesis and synopses on dev.perl.org. that book was out of date the
moment the trees were felled. :) the running joke on the perl6 lists is
what changes/flip-flops did larry make this week!
MD> (2) Perl is known for being inspired from a mixture of many other
MD> languages/programs. It seems evident that the new OO features of
MD> Perl6 resemble a lot those of some widely used OO languages, but
MD> are there any other languages that specifically influenced some
MD> choices about its syntax and semantic?
if you read those docs and some of the mail threads and if you dare to
read the rfc's, you will get a partial answer to that question. perl6 is
blatantly stealing/borrowing from anyone who has an interesting idea
that can be worked into a perlish way. in fact the concept of roles in
OO is better than any of the popular OO langs as it can support many of
their needs in a more elegant and integrated way.
perl6 will be one of the most publicly designed systems in history IMO.
uri
--
Uri Guttman ------ uri@stemsystems.com -------- http://www.stemsystems.com
--Perl Consulting, Stem Development, Systems Architecture, Design and Coding-
Search or Offer Perl Jobs ---------------------------- http://jobs.perl.org
------------------------------
Date: 28 May 2004 17:59:02 -0700
From: constants@mix-net.net (Mark Constant)
Subject: Re: Why is this upload script not working
Message-Id: <ce43fdea.0405281659.7c859f99@posting.google.com>
Well I added some more changes and the error I get from Carp is below.
I don't see how this error can be. I chmod my quickbooks directory to
777. The directory structure is basic.
/var/www/htdocs
/var/www/htdocs/quickbooks
/var/www/cgi-bin/uploader.cgi
Upload Results
Filename: loadlin16c.zip
Destination: ../htdocs/quickbooks/loadlin16c.zip
MIME Type: application/x-zip
Content-type: text/html
Software error:
Didn't work because of File Permission
For help, please send mail to the webmaster
Here is my updated code again
use CGI;
use CGI::Carp qw/fatalsToBrowser/;
use strict;
use warnings;
my $q = CGI->new();
my $file = $q->param('upfile');
$file =~ /^([w.-]+)$/;
my $dir = '../htdocs/quickbooks';
print $q->header, $q->start_html('Uploading File');
print $q->h1('Upload Results');
if(!$file){
print "Nothing Uploaded\n";
} else {
print "Filename: $file<br />\n";
print "Destination: $dir/$file<br />\n";
my $ctype = $q->uploadInfo($file)->{'Content-Type'};
print "MIME Type: $ctype<br />\n";
open(OUTFILE, '>$dir/$filename') or die("Didn't work because of $!
\n");
binmode(OUTFILE);
while (my $bytesread = read($file, my $buffer, 1024)) {
print OUTFILE $buffer;
}
close(OUTFILE);
print "File saved\n";
}
$q->end_html;
sub die {
my($msg) = @_;
print "<h2>Error</h2>\n";
print $msg;
exit;
}
------------------------------
Date: Fri, 28 May 2004 18:59:33 -0600
From: Scott Bryce <sbryce@scottbryce.com>
Subject: Re: Why is this upload script not working
Message-Id: <10bfo3i1hma2j66@corp.supernews.com>
Gunnar Hjalmarsson wrote:
> What does the form look like? That's also important. :)
Your form tag should look something like:
<form action="myscript.pl" method=post ENCTYPE="multipart/form-data">
If you don't include the enctype in the form tag, your file will not be
uploaded to the server. Your script will appear to work because it will
correctly process the nothing that was sent to it.
------------------------------
Date: 29 May 2004 02:13:41 GMT
From: Eric Bohlman <ebohlman@omsdev.com>
Subject: Re: Why is this upload script not working
Message-Id: <Xns94F7D89E8BFFAebohlmanomsdevcom@130.133.1.4>
constants@mix-net.net (Mark Constant) wrote in
news:ce43fdea.0405281659.7c859f99@posting.google.com:
> Here is my updated code again
> use CGI;
> use CGI::Carp qw/fatalsToBrowser/;
You throw away the benefits of using this by defining your own die() sub
later on. CGI::Carp redefines Perl's built-in die() to properly output to
the browser, but you're using your own die() which, among other things,
won't be able to report compile-time errors.
> use strict;
> use warnings;
For reasons that will become clear later, add 'use Cwd;' here.
> my $q = CGI->new();
>
> my $file = $q->param('upfile');
> $file =~ /^([w.-]+)$/;
This is worse than useless. It silently bypasses taint-checking while
still allowing dangerous filenames through. At the very least, change it
to
$file =~ /^([w.-]+)$/ or die "Unacceptable file name: $file";
though in production you'd want to do something more user-friendly.
> my $dir = '../htdocs/quickbooks';
In a CGI context, relative pathnames are a red flag unless you've done an
explicit chdir(). Your cwd often isn't what you think it is when you're
running as a CGI process. And when it is what you think it is, it's often
so only by coincidence. Code that relies on relative paths without a
chdir() has a nasty habit of breaking if moved to another server, or if the
current server is reconfigured.
> print $q->header, $q->start_html('Uploading File');
> print $q->h1('Upload Results');
>
> if(!$file){
> print "Nothing Uploaded\n";
> } else {
> print "Filename: $file<br />\n";
> print "Destination: $dir/$file<br />\n";
print 'cwd is: ',cwd,"<br />\n";
This will tell you what your cwd is. Please do *not* respond to this post
until *after* you've tried this. There's no point in people trying to
guess whether or not you're in the right directory when you can have perl
*tell* you.
> my $ctype = $q->uploadInfo($file)->{'Content-Type'};
> print "MIME Type: $ctype<br />\n";
> open(OUTFILE, '>$dir/$filename') or die("Didn't work because of $!
> \n");
$filename is neither declared nor used in any of your code. Since you have
strict turned on, either your code failed to compile, with the error
message being lost because you overrode die(), or your actual code uses
$file, in which case you're wasting everybody's time by posting mutant
code.
> binmode(OUTFILE);
> while (my $bytesread = read($file, my $buffer, 1024)) {
> print OUTFILE $buffer;
> }
> close(OUTFILE);
> print "File saved\n";
> }
>
> $q->end_html;
>
> sub die {
> my($msg) = @_;
> print "<h2>Error</h2>\n";
> print $msg;
> exit;
>
> }
Once again, you shouldn't do this.
If your problem really is a permissions error, it's likely to be because
your cwd isn't what you think it is.
------------------------------
Date: Sat, 29 May 2004 04:43:53 +0200
From: Gunnar Hjalmarsson <noreply@gunnar.cc>
Subject: Re: Why is this upload script not working
Message-Id: <2hqbtvFfqig3U1@uni-berlin.de>
Eric Bohlman wrote:
> Mark Constant wrote:
>>
>> my $file = $q->param('upfile');
>> $file =~ /^([w.-]+)$/;
>
> This is worse than useless. It silently bypasses taint-checking
> while still allowing dangerous filenames through. At the very
> least, change it to
>
> $file =~ /^([w.-]+)$/ or die "Unacceptable file name: $file";
Suppose you mean \w
But besides that, $file does still not get untainted, so that's not
very useful either.
if ($file =~ /^([\w.-]+)$/) {
$file = $1;
} else {
die "Unacceptable file name: $file";
}
--
Gunnar Hjalmarsson
Email: http://www.gunnar.cc/cgi-bin/contact.pl
------------------------------
Date: Sat, 29 May 2004 09:49:47 +0000 (UTC)
From: Ben Morrow <usenet@morrow.me.uk>
Subject: Re: Why is this upload script not working
Message-Id: <c99mbr$50i$1@wisteria.csv.warwick.ac.uk>
Quoth Gunnar Hjalmarsson <noreply@gunnar.cc>:
> Eric Bohlman wrote:
> > Mark Constant wrote:
> >>
> >> my $file = $q->param('upfile');
> >> $file =~ /^([w.-]+)$/;
> >
> > This is worse than useless. It silently bypasses taint-checking
> > while still allowing dangerous filenames through. At the very
> > least, change it to
> >
> > $file =~ /^([w.-]+)$/ or die "Unacceptable file name: $file";
>
> Suppose you mean \w
>
> But besides that, $file does still not get untainted, so that's not
> very useful either.
>
> if ($file =~ /^([\w.-]+)$/) {
> $file = $1;
This is still wrong; had he actually read my last post this would have
been clear...
$file is a CGI file upload object. You need to use a different variable
for the untainted filename.
Ben
--
I must not fear. Fear is the mind-killer. I will face my fear and
I will let it pass through me. When the fear is gone there will be
nothing. Only I will remain.
ben@morrow.me.uk Frank Herbert, 'Dune'
------------------------------
Date: 6 Apr 2001 21:33:47 GMT (Last modified)
From: Perl-Users-Request@ruby.oce.orst.edu (Perl-Users-Digest Admin)
Subject: Digest Administrivia (Last modified: 6 Apr 01)
Message-Id: <null>
Administrivia:
#The Perl-Users Digest is a retransmission of the USENET newsgroup
#comp.lang.perl.misc. For subscription or unsubscription requests, send
#the single line:
#
# subscribe perl-users
#or:
# unsubscribe perl-users
#
#to almanac@ruby.oce.orst.edu.
NOTE: due to the current flood of worm email banging on ruby, the smtp
server on ruby has been shut off until further notice.
To submit articles to comp.lang.perl.announce, send your article to
clpa@perl.com.
#To request back copies (available for a week or so), send your request
#to almanac@ruby.oce.orst.edu with the command "send perl-users x.y",
#where x is the volume number and y is the issue number.
#For other requests pertaining to the digest, send mail to
#perl-users-request@ruby.oce.orst.edu. Do not waste your time or mine
#sending perl questions to the -request address, I don't have time to
#answer them even if I did know the answer.
------------------------------
End of Perl-Users Digest V10 Issue 6624
***************************************
