OGP-Agent-Linux/FastDownload/ForkedDaemon.pm

use strict;
use warnings;
use lib ".";
use FastDownload::Settings; # Daemon Settings
use Cwd;					# Fast way to get the current directory
use Fcntl ':flock';			# Import LOCK_* constants for file locking
use File::Copy;				# Simple file copy functions
use Path::Class::File;		# Handle files and directories.
use HTTP::Daemon;			# Create the Fast Download Daemon.
use URI::Escape;			# Translate url code for example: %20 to space
use Socket qw( inet_aton );	# Work with network addresses.

use constant RUN_DIR => getcwd();
use constant FD_DIR => Path::Class::Dir->new(RUN_DIR, 'FastDownload');
use constant FD_ALIASES_DIR => Path::Class::Dir->new(FD_DIR, 'aliases');
use constant FD_PID_FILE => Path::Class::File->new(FD_DIR, 'fd.pid');
use constant FD_LOG_FILE => Path::Class::File->new(FD_DIR, 'fastdownload.log');

### Logger function.
### @param line the line that is put to the log file.
sub logger
{
	my $logcmd	 = $_[0];
	my $also_print = 0;

	if (@_ == 2)
	{
		($also_print) = $_[1];
	}

	$logcmd = localtime() . " $logcmd\n";

	if ($also_print == 1)
	{
		print "$logcmd";
	}

	open(LOGFILE, '>>', FD_LOG_FILE)
	  or die("Can't open " . FD_LOG_FILE . " - $!");
	flock(LOGFILE, LOCK_EX) or die("Failed to lock log file.");
	seek(LOGFILE, 0, 2) or die("Failed to seek to end of file.");
	print LOGFILE "$logcmd" or die("Failed to write to log file.");
	flock(LOGFILE, LOCK_UN) or die("Failed to unlock log file.");
	close(LOGFILE) or die("Failed to close log file.");
}

# Rotate the log file
if (-e FD_LOG_FILE)
{
	if (-e FD_LOG_FILE . ".bak")
	{
		unlink(FD_LOG_FILE . ".bak");
	}
	logger "Rotating log file";
	move(FD_LOG_FILE, FD_LOG_FILE . ".bak");
	logger "New log file created";
}

if (open(PIDFILE, '>', FD_PID_FILE))
{
	print PIDFILE $$;
	close(PIDFILE);
}

$SIG{'PIPE'} = 'IGNORE';

my $fd = HTTP::Daemon->new(LocalAddr=>$FastDownload::Settings{ip},
						   LocalPort=>$FastDownload::Settings{port},
						   ReuseAddr=>'1') || die;

logger "Fast Download Daemon Started at: <URL:" . $fd->url . "> - PID $$",1;

my %aliases;
if(-d FD_ALIASES_DIR)
{
	if( !opendir(ALIASES, FD_ALIASES_DIR) )
	{
		logger "Error openning aliases directory " . FD_ALIASES_DIR . ", $!";
	}
	else
	{
		while (my $alias = readdir(ALIASES))
		{
			# Skip . and ..
			next if $alias =~ /^\./;
			if( !open(ALIAS, '<', Path::Class::Dir->new(FD_ALIASES_DIR, $alias)) )
			{
				logger "Error reading alias '$alias', $!";
			}
			else
			{
				my @file_lines = ();
				my $i = 0;
				while (<ALIAS>)
				{
					chomp $_;
					$file_lines[$i] = $_;
					$i++;
				}
				close(ALIAS);
				$aliases{$alias}{home}                  = $file_lines[0];
				$aliases{$alias}{match_file_extension}  = $file_lines[1];
				$aliases{$alias}{match_client_ip}       = $file_lines[2];
			}
		}
		closedir(ALIASES);
	}
}
else
{
	logger "Aliases directory '" . FD_ALIASES_DIR . "' does not exist or is inaccessible.";
}

$SIG{CHLD} = 'IGNORE';
while (my $c = $fd->accept) {
	my $pid = fork();
	if (not defined $pid)
	{
		logger "Could not allocate resources for Fast Download Client.",1;
	}
	# Only the forked child goes here.
	elsif ($pid == 0)
	{
		if(%aliases)
		{
			while(my $r = $c->get_request) {
				process_client_request($FastDownload::Settings{listing}, $r, $c);
				$c->close;
			}
		}
		else
		{
			while(my $r = $c->get_request) {
				$c->send_error(403,"");
				$c->close;
			}
		}
		undef($c);
		# Child process must exit.
		exit(0);
	}
}

sub process_client_request
{
	my($listing, $r, $c) = @_;
	my @uri_alias = split /\//, $r->uri->path;
	if(defined $uri_alias[1])
	{
		my $alias = $uri_alias[1];
		if ($r->method eq 'GET' and defined $aliases{$alias})
		{
			my $home = $aliases{$alias}{home};
			my (@extensions,@subnets);
			if(defined $aliases{$alias}{match_file_extension})
			{
				@extensions = split /,/, $aliases{$alias}{match_file_extension};
			}
			if(defined $aliases{$alias}{match_client_ip})
			{
				@subnets = split /,/, $aliases{$alias}{match_client_ip};
			}
			my $client = getpeername($c);
			my ($port, $iaddr) = unpack_sockaddr_in($client);
			my $client_ip = inet_ntoa($iaddr);
			my $uri = uri_unescape($r->uri->path);
			my $escaped_alias = "\/" . $alias;
			$uri =~ s/^$escaped_alias//g;
			my $location = $home . $uri;
			my $is_subnet;
			if(!grep {defined($_)} @subnets)
			{
				$is_subnet = 1;
			}
			else
			{
				foreach my $subnet (@subnets)
				{
					$is_subnet = in_subnet($client_ip, $subnet);
					if($is_subnet)
					{
						last;
					}
				}
			}
			if($is_subnet)
			{
				if(-d $location)
				{
					my $index = $location . "/" . "index.html";
					if(-f $index)
					{
						$c->send_file_response($index);
					}
					else
					{
						if($listing == 1)
						{
							# Loop through all files and folders
							my @dirs = ();
							my @bins = ();
							my @files = ();
							opendir(DIR, $location);
							while (my $entry = readdir(DIR))
							{
								# Skip . and ..
								next if $entry =~ /^\./;
								my $link_location = $location."/".$entry;
								if(-d $link_location)
								{
									push(@dirs, $entry);
								}
								elsif(-B $link_location)
								{
									push(@bins, $entry);
								}
								else
								{
									push(@files, $entry);
								}
							}
							closedir(DIR);
							@dirs = sort @dirs;
							@bins = sort @bins;
							@files = sort @files;
							my ($content, $href);
							foreach my $dir (@dirs)
							{
								$href = Path::Class::Dir->new($r->uri->path, $dir);
								$content .= "<a href='" . $href . "' >".$dir."</a><br>";
							}
							foreach my $bin (@bins)
							{
								$href = Path::Class::File->new($r->uri->path, $bin);
								$content .= "<a href='" . $href . "' >".$bin."</a><br>";
							}
							foreach my $file (@files)
							{
								$href = Path::Class::File->new($r->uri->path, $file);
								$content .= "<a href='" . $href . "' >".$file."</a><br>";
							}
							my $response = HTTP::Response->new(200);
							$response->content($content);
							$response->header("Content-Type" => "text/html");
							$c->send_response($response);
						}
						else
						{
							$c->send_error(403,"");
						}
					}
				}
				else
				{
					my @extension = split /\./, $uri;
					my $extension = $extension[-1];
					if(grep {$_ eq $extension} @extensions or !grep {defined($_)} @extensions)
					{
						$c->send_file_response($location);
					}
					else
					{
						$c->send_error(403,"");
					}
				}
			}
			else
			{
				$c->send_error(403,"");
			}
		}
		else
		{
			$c->send_error(403,"");
		}
	}
	else
	{
		$c->send_error(403,"");
	}
}

sub ip2long($)
{
	return( unpack( 'N', inet_aton(shift) ) );
}

sub in_subnet($$)
{
	my $ip = shift;
	my $subnet = shift;
	my $ip_long = ip2long( $ip );
	if( $subnet=~m|(^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/(\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})$| )
	{
		my $subnet = ip2long($1);
		my $mask = ip2long($2);
		if( ($ip_long & $mask)==$subnet )
		{
			return 1;
		}
	}
	elsif( $subnet=~m|(^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3})/(\d{1,2})$| )
	{
		my $subnet = ip2long($1);
		my $bits = $2;
		my $mask = -1<<(32-$bits);
		$subnet&= $mask;
		if( ($ip_long & $mask)==$subnet )
		{
			return 1;
		}
	}
	elsif( $subnet=~m|(^\d{1,3}\.\d{1,3}\.\d{1,3}\.)(\d{1,3})-(\d{1,3})$| )
	{
		my $start_ip = ip2long($1.$2);
		my $end_ip = ip2long($1.$3);
		if( $start_ip<=$ip_long and $end_ip>=$ip_long )
		{
			return 1;
		}
	}
	elsif( $subnet=~m|^[\d\*]{1,3}\.[\d\*]{1,3}\.[\d\*]{1,3}\.[\d\*]{1,3}$| )
	{
		my $search_string = $subnet;
		$search_string=~s/\./\\\./g;
		$search_string=~s/\*/\.\*/g;
		if( $ip=~/^$search_string$/ )
		{
				return 1;
		}
	}
	return 0;
}