#!c:/perl/bin/Perl.exe

# Remote'EmAll socket-server ver. 1.02b
# http://www.petripaavola.fi/remoteemall


use strict;
use IO::Socket;
use Net::hostent;
use LWP::Simple;
use File::Find;
use Win32::OLE;

####################### Check these settings !!! ###############################

# Password for Remote'EmAll-socket-server. Remember to set this also to Remote'EmAll client
my $socketpasswd = "Passw0rd";
# Port to listen to
my $socketport = "7070";

# '<' is folder separator. Make sure you type dirs exactly as they are on example.
# Dirs to make search-database
my $dir = "C:/mp3<D:/mp3<C:/video<E:/tv-recordings";
# Dirs to allow realtime filesystem browsing
my $browsedirs = "C:\\mp3\\<D:\\mp3\\<C:\\video\\<E:\\tv-recordings\\";

# Dirs and files where to store search-databases
my $folders = "C:/folders.txt";
my $folders_and_files = "C:/folders_and_files.txt";

###############################################################################

my $clientIP = "";
my $client = "";

my $server = new IO::Socket::INET
	(LocalPort => $socketport,
	 Proto => 'tcp',
	 Listen => 1,
	 Reuse => 1,
	);
die "Could not create socket: $!\n" unless $server;
print "[Server $0 accepting clients]\n";


# when using "Search files" or "Search folders" command
sub findmedia {
	my ($filename, $my_data) = @_;
	my $counter = 0;
	my $return = "";

	my @searchwords = split( / /, $my_data);

	open(FOLDERS, $filename);
	while(<FOLDERS>) {

	  chomp;
	  my $line = $_;
	  my $found = 0;

	FOREACH: foreach my $searchword(@searchwords) {
		chomp $searchword;
 
		if ($searchword =~ /^\Q$socketpasswd\E/) { next FOREACH; }
		if ($searchword =~ /^find_folders/) { next FOREACH; }
		if ($searchword =~ /^find_folders_and_files/) { next FOREACH; }

		if ($line =~ /\Q$searchword\E/i) {
			$found = 1;
#			print $line;
		} else {
	      		$found = 0;
			last FOREACH;
		}
	  }

	  if ($found == 1) {

	     # Max. hits to return
	    if($counter > '499') {
		$return = $return . "----   Showing only 500 hits   ----#";
		last;
	    }

	    # WinampRemoteSearch-program separates hits with '<'
		$return = $return . "$line<";
		$counter = $counter + 1;
	  }
	}
	chop($return);
	print "return: $return\n";
	print $client "$return\n";
	close (FOLDERS);
}

# Add media to winamp playlist
sub winampPlayFile {
	my $parameters = $_;
	my @parameters = split( / /, $parameters, 3);
	my $url = $parameters[2];

	print "$url\n";
#	print "Content-type: text/html\n\n";
	my $doc = get $url;
	print $client "$doc\n";
}

# Add media to Media Player Classic
sub mpcBrowse {
	my $parameters = $_;
	my @parameters = split( / /, $parameters, 3);
	my $url = $parameters[2];

	$url =~ s/ /+/g;
	$url =~ s/ä/%c3%a4/g;
	$url =~ s/ö/%c3%b6/g;
	$url =~ s/Ä/%c3%84/g;
	$url =~ s/Ö/%c3%96/g;
	$url =~ s/Å/%c3%85/g;
	$url =~ s/å/%c3%a5/g;
	
	print "$url\n";
#	print "Content-type: text/html\n\n";
	my $doc = get $url;
#	print $client $doc;
	print $client "MPC Browse ok\n";
}

# Add media to VLC playlist
sub vlcAddMRL {
	my $parameters = $_;
	my @parameters = split( / /, $parameters, 3);
	my $url = $parameters[2];

	$url =~ s/ /+/g;
#	$url =~ s/ä/%c3%a4/g;
#	$url =~ s/ö/%c3%b6/g;
#	$url =~ s/Ä/%c3%84/g;
#	$url =~ s/Ö/%c3%96/g;
#	$url =~ s/Å/%c3%85/g;
#	$url =~ s/å/%c3%a5/g;

	print "$url\n";
#	print "Content-type: text/html\n\n";
	my $doc = get $url;
#	print $client $doc;
	print $client "VLC Add MRL ok\n";
}


# Realtime filesystem browsing
sub browsefolders {
	my $parameters = $_;

	my @parameters = split( / /, $parameters, 3);
	chomp $parameters[2];
	my $folder = $parameters[2];

	my $folderOK = "0";

	my @browsedirs = split("<", $browsedirs);
	foreach my $dirrit(@browsedirs) {
		if($dirrit && $folder =~ /^\Q$dirrit\E/) {
			print "$folder  $dirrit\n";
			$folderOK = "1";
		}
	}


	if($folderOK eq "0") {
		$folder = "\\";
	}
	if($folder eq "\\") {
		print $client "\\<$browsedirs\n";
		print "\\<$browsedirs\n";
	} else {
		print "$folder\n";
		print $client "$folder<";
		opendir (FOLDER, $folder) or die "Couldn't open folder $folder\n!";

		my @allfiles = grep !/^\./, readdir FOLDER;
		closedir FOLDER;

		foreach (@allfiles) {

			if (-d "$folder/$_") {
				print $client "$_\\<";
				print "$_\\<";
			} else {
				print $client "$_<";
				print "$_<";
			}
		}
	}
	print $client "\n";
	print "\n";
}

# Make folder and files "database" files to use with find-commands
sub scan {
	open(FILES, ">", $folders_and_files);
	open(FOLDERS, ">", $folders);

	my @dirs = split( /</, $dir);
	foreach $dir(@dirs) {
#		chomp $searchword;
		sub edits() {
			my $files = $File::Find::name;
			stat $files;
			# If it is folder
			if (-d) {
				$files =~ s/\//\\/g;
				print FOLDERS "$files\n";
			}
			$files =~ s/\//\\/g;
			print FILES "$files\n";
		}

	find(\&edits, $dir);
	}
	close(FILES);
	close(FOLDERS);
	print "files scanned\n";
}


# If you wan't to make your own batch-commands. You could for example open firewall ports to the ip-address
# that just made connection to RemoteEmAll-socket-server. That way you can secure that no one else can't try to connect
# to your Winamp, MPC or VLC web frontend.
sub ownBatchCommand {
	my $strCommand = 'c:/temp/ownBatchCommand.bat ' . $clientIP;

	print "Running command: $strCommand\n";
	print "\n";
	my $objShell = Win32::OLE->new('Wscript.Shell');
	my $objProc = $objShell->Exec($strCommand);

	do {
		select(undef, undef, undef, 100 / 1000.0);
	} until ($objProc->Status != 0);

	if ($objProc->ExitCode != 0) {
		print 'EXIT CODE: ' . $objProc->ExitCode, "\n";
		print 'ERROR: ' . $objProc->StdErr->ReadAll, "\n";
	}

	print 'OUTPUT: ' . $objProc->StdOut->ReadAll, "\n";
	print $client "ownBatchCommand.bat succeeded with parameter $clientIP\n"
}



##################### Main starts here ########################################

while ($client = $server->accept()) {

#  printf "Command: %s\n", $client;
	
   printf "[Connect from %s with command ", $client->peerhost;
   $clientIP = $client->peerhost;
   while ( <$client>) {
	   my $command = $_;

	   # Remove special characters you don't have to use
	   $command =~ s/[\t\r\n;\>\*\?\"\|\/]+//g;

	   # Cut command to 300 characters
	   #$command =~ s/^(.{0,300}).*$/$1/;
	   $command = substr($command,0,300);

	   printf "%s]\n", $command;
	   next unless /\S/;	     # blank line
	   # date or time command is just for testing purposes. That's the easiest way to check that your socket-server is working
	   # Just type "date" or "time" to Command line and select 'Custom cmd' from menu.
	   if ($command =~ /^\Q$socketpasswd\E date$|^\Q$socketpasswd\E time$/)  { printf $client "%s\n", scalar localtime;  	}
# If you wan't to make your own commands which runs scripts
#	   elsif ($command =~ /^\Q$socketpasswd\E ownBatchCommand/)		{ ownBatchCommand(); }
	   elsif ($command =~ /^\Q$socketpasswd\E find_folders /) 		{ findmedia($folders, $command); 		}
	   elsif ($command =~ /^\Q$socketpasswd\E find_folders_and_files /) 	{ findmedia($folders_and_files, $command); 	}
	   elsif ($command =~ /^\Q$socketpasswd\E browsefolders /)		{ browsefolders($command);			}
	   elsif ($command =~ /^\Q$socketpasswd\E winampPlayFile /) 		{ winampPlayFile($command); 			}
	   elsif ($command =~ /^\Q$socketpasswd\E mpcBrowse /)			{ mpcBrowse($command);				}
	   elsif ($command =~ /^\Q$socketpasswd\E vlcAddMRL /)			{ vlcAddMRL($command);				}
	   elsif ($command =~ /^\Q$socketpasswd\E scan$/)	 		{ print $client "Scan started\n"; scan; }
	   else { print $client "\n"; }
   } #continue {
#      print $client "Error in command!n";
#   }
   close $client;
}

close($server);