#!/usr/bin/perl -w

#Software License Agreement (BSD License)
#
#Copyright (c) 2000 Sonettic, max klymyshyn
#All rights reserved.
#
#Redistribution and use in source and binary forms, with or without
#modification, are permitted provided that the following conditions
#are met:
#1. Redistributions of source code must retain the above copyright
#   notice, this list of conditions and the following disclaimer.
#2. Redistributions in binary form must reproduce the above copyright
#   notice, this list of conditions and the following disclaimer in the
#   documentation and/or other materials provided with the distribution.
#3. The name of the author may not be used to endorse or promote products
#   derived from this software without specific prior written permission.
#
#THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDER AND AUTHOR ``AS IS'' AND ANY EXPRESS OR
#IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES
#OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
#IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT,
#INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT
#NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
#DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
#THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
#(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF
#THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#


# www.sonettic.com
# more: joymaxstory.blogspot.net

# Usage:
#
# &dl_file_resume("path_to_file");
#



use strict;
use File::Basename;

my $BUFFER = 1024 * 2;
my $EO = "\r\n";


sub dl_file_resume {
	my ($filename) = @_;
	
	#check for file existing and have read access
	if (!(-e $filename) || !(-r $filename)){ &fatal_error(404);}

	#basename
	my ($basicFileName, $folderPath, $extension) = fileparse($filename, qr{\..*});
	my $clearFileName = $basicFileName . $extension;
	my $fullFileExtension = $extension;
	#drop dot
	my $justFileExtension = length($extension) > 1 ? substr(lc($extension), 1, length($extension) - 1) : "";

	
	#setting ContentType
	my $ctype = "application/force-download";
	
	if($justFileExtension eq "exe" or $justFileExtension eq "msi"){
		$ctype="application/octet-stream";
	}elsif($justFileExtension eq "zip"){
		$ctype="application/zip";
	}elsif($justFileExtension eq "mp3"){
		$ctype="audio/mpeg";
	}elsif($justFileExtension eq "mpg"){
		$ctype="audio/mpeg";
	}elsif($justFileExtension eq "avi"){
		$ctype="video/x-msvideo";
	}

	
	if($ENV{'HTTP_USER_AGENT'} =~ "MSIE 6."){
		# workaround for IE filename bug with multiple periods / multiple dots in filename
		# that adds square brackets to filename - eg. setup.abc.exe becomes setup[1].abc.exe
		my $rpc = '%2e';
		$clearFileName =~ s/\./$rpc/e;	
	}
	

	#getting file size
	my $filesize = -s $filename;
	#filesize-1 for range header
	my $filesize2 = $filesize - 1;
	
	my $rangeStart = 0;
	my $rangeEnd = $filesize;
	my $contentLength = 0;
	my $contentRange = undef;
	my $http_status = "";
	
	#check if http_range is sent by browser (or download manager)
	if(defined $ENV{HTTP_RANGE}){
		my $httpRange = $ENV{HTTP_RANGE};
		if ($httpRange =~ m/^bytes=(\d*)-(\d*)$/) {
			$rangeStart = $1 || 0;
			$rangeEnd   = $2 || $filesize;
			if($rangeEnd > $filesize) {
				&fatal_error(416);
			}
		}else{
			&fatal_error(400);
		}
		$contentLength = $rangeEnd - $rangeStart;

		$contentRange = "$rangeStart-$filesize2/$filesize";
		$http_status = "Status: 206 Partial Content" . $EO;
		
	}else{
		$contentRange = "bytes 0-$filesize2/$filesize";
		$contentLength = $filesize;		
	}
	
	#print out file	
	local *IN;
	open (IN, "<$filename") || &fatal_error(404);
	binmode IN;
	seek (IN, $rangeStart, 0) || &fatal_error(404);

	my $buf = '';
	my $n;

	#Begin writing headers
	print $http_status;
	print "Cache-Control:" . $EO;
	print "Cache-Control: public" . $EO;
	print "Content-Disposition: attachment; filename=\"$clearFileName\"" . $EO;
	print "Accept-Ranges: bytes" . $EO;
	print "Content-Type: $ctype" . $EO;
	print "Content-Length: $contentLength" . $EO;
	print "Content-Range: bytes $contentRange" . $EO . $EO;


	while ( read( IN, $buf, $BUFFER ) ) {
		print $buf;
	}
	
	close (IN);
}

sub fatal_error {
	#send http reply with error code
	my ($errorCode) = @_;

	my $status = "500 Internal Server Error";
	if($errorCode == 404){
		$status = "404 Not Found";
	}elsif($errorCode == 400){
		$status = "400 Bad Request";
	}elsif($errorCode == 416){
		$status = "416 Requested Range Not Satisfiable";
	}elsif($errorCode ==402){
		$status = "402 Payment Required";
	}
	
	print "Status: $status" . $EO . $EO;
	exit;
}