On Friday, March 26, 2004 12:50 AM, Shaun Fryer <[EMAIL PROTECTED]> wrote: : : > 4. Decoded file is streamed to user, who saves the file locally. : > Jason
[snip] : #!/usr/bin/perl : : ############################################################## : To download a file via a GET request : http://yourhost.tld/path/to/thisScript.cgi?f=/path/to/fileYouWant : ############################################################## : : # to restrict which hosts can access this script : # enter your full or partial IP address below : # or comment it out to allow unrestricted access : : $remote_ip = '192.168.0.'; : : ############################################################## : use CGI; : $q = new CGI; : if ($ENV{REMOTE_ADDR} =~ /^$remote_ip/) { The periods inside $remote_ip will match any character, not just periods. Better safe than sorry. if ($ENV{REMOTE_ADDR} =~ /^\Q$remote_ip\E/) { : if ($q->param('f')) { : $file = $q->param('f'); : if (!-e "$file") { Why is $file in quotes? : print $q->header, : $q->start_html, : $file." doesn't exist!", : $q->end_html; : } elsif (!-r "$file") { Why is $file in quotes? : $me = `whoami`; : print $q->header, : $q->start_html, : $file." isn't readable by ".$me."!", None of these variables are in quotes?!? : $q->end_html; : } else { : $size = (stat $file)[7]; Is there a possibility that (stat $file)[7] will return undef? : $file_name = $file; Hmmm. $file is not in quotes here ... : $file_name =~ s/.*\///; : select STDOUT; : $| = 1; : print "Content-Type: application\/force-download\n", : "Content-Disposition: attachment\; : filename=$file_name\n", : "Content-Length: $size\n", : "Content-Description: sfryer\'s file : downloader\n\n"; Shame! Shame! Shame! Shame. You loaded the darn thing -- use it: print $q->header( -Content_Type => q|application/force-download|, -Content_Disposition => qq|attachment; filename=$file_name|, -Content_Length => $size, -Content_Description => q|sfryer's file downloader|, ); : open(OUT,"<$file"); Always, always check the status of an open. Always! open OUT, "<$file" or die qq|Cannot open "$file": $!|; : binmode OUT if (-B "$file"); Why is $file in quotes. What do you wish to accomplish that this will not: binmode OUT if -B $file; : $block_size = (stat OUT)[11]; : $block_size = 16384 unless ($block_size); $block_size = (stat OUT)[11] || 13684; Okay, this is the biggie! : while ($length = sysread OUT, $buffer, $block_size) { : unless (defined $length) { next if $! =~ : /^Interrupted/; } : $written = 0; : $offset = 0; : while ($length) { $written = syswrite STDOUT, : $buffer, $length, $offset; } : $len -= $written; $len is only used once. Did you mean $length ?!? : $offset += $written; The next time $offset is used, it is always set to 0. So this statement is meaningless. : } : close(OUT); : } : } : } : exit 0; Did I mention that you shouldn't quote variables unnecessarily? :) Here's my (untested) attempt. #!/usr/bin/perl use strict; use warnings; use CGI; my $q = new CGI; my $remote_ip = '192.168.0.'; my $file = $q->param('f'); $q->redirect( 'http://www.some-domain.com/cgi-form.html' ) unless $file && $ENV{REMOTE_ADDR} =~ /^\Q$remote_ip\E/; unless ( -e $file ) { print $q->header, $q->start_html, qq|$file doesn't exist!|, $q->end_html; exit; } unless ( -r $file ) { my $me = `whoami`; print $q->header, $q->start_html, $file, qq| isn't readable by "$me"!|, $q->end_html; exit; } my $file_name = $file; $file_name =~ s/.*\///; select STDOUT; $| = 1; print $q->header( -Content_Type => q|application/force-download|, -Content_Disposition => qq|attachment; filename=$file_name|, -Content_Length => (stat $file)[7], -Content_Description => q|sfryer's file downloader|, ); open OUT, "<$file" or die qq|Cannot open "$file": $!|; binmode OUT if -B $file; my $block_size = (stat OUT)[11] || 16384; while ( my $length = sysread OUT, my $buffer, $block_size ) { next unless defined $length; my $offset = 0; while ( $length ) { my $written = syswrite STDOUT, $buffer, $length, $offset; $length -= $written; $offset += $written; } } close OUT; HTH, Charles K. Clarkson -- Mobile Homes Specialist 254 968-8328 -- To unsubscribe, e-mail: [EMAIL PROTECTED] For additional commands, e-mail: [EMAIL PROTECTED] <http://learn.perl.org/> <http://learn.perl.org/first-response>
