Forking in Perl on Apache webserver
I'm currently running Apache 2.0 on Slackware 9.0. I currently have a link called "Fetch" on my webpage that will run a specific function. This function is designed to fork and in the parent print out some garbage about what the function is doing and in the child execute a system command (in this case its going to zip up some files, send it to the user, and then delete the zip file). I have everything working except for the very last part (sending the file to the user). I don't think I'm sending the file to STDOUT, but I can't find anything in the error_log. Any ideas? The function is below so you can better understand what I have done so far. Thanks. (Oh yeah, I'm using the Apache::MP3 module so that's where some of the those weird functions are coming from).
sub fetch_archive {
my $self = shift;
my $r = $self->r;
my $path = "\"/usr/website/music" . $r->uri . "\"";
my $random = $r->uri;
my @fileholder;
my $attachment;
$random =~ /\/.+\/(.+)\//; #gets latter part of path for filename
$random = $1;
$random =~ s/ //g;
$random = $random . rand() . ".zip"; #creates random filename
if(!fork)
{
sleep(5); #pauses child so parent executes first
close(STDIN); close(STDOUT); close(STDERR);
`zip -0 -r -j -9 /usr/website/realdocs/$random $path`; #zip files
open (FILE, "</usr/website/realdocs/$random");
print STDOUT header("Content-Length: " . (-s "/usr/website/realdocs/" . $random));
print STDOUT header("Content-type: application/octet-stream");
print STDOUT header("Content-disposition: $attachment filename={$random}");
print STDOUT header("Content-Transfer-Encoding: binary");
print STDOUT $_ while ( read( FILE, $_, 1024 ) ); #send to client
close FILE;
`rm /usr/website/realdocs/$random`; #delete file
exit;
}
else
{
$self->r->content_type( $self->html_content_type );
return Apache::OK if $self->r->header_only;
print start_html(
-lang => $self->lh->language_tag,
-title => $self->x('Downloading'),
-dir => $self->lh->direction,
-head => meta({-http_equiv => 'Content-Type',
-content => 'text/html; charset='
. $self->html_content_type
}),
);
print $self->x("Zipping files for download...This may take up to 5 minutes."), br();
print $self->x("A dialog box will popup automatically when the file is ready for download."), br();
print $self->x("In the mean time you may go back and continue using the site.");
print end_html();
exit;
}
return Apache::OK;
}
|