#! /usr/bin/perl -w
#--------------------
# server.pl
# Stream2Dream Linux server. This is the replacement for the .Net version of windows.
# It needs perl, samba and vlc.
# Current version: 2.5 (21-08-2008)
#
# Change log:
# ===========
# 21-08-2008:
# Updated the server to version 2.5. Based on the LT Team 5 Campaign
# Added tv streams
# Multi-threaded to add caching progress
#
# 15-03-2008:
# Updated the server to version 2.0. Based on the LT Team 4 Revolution image.
# Added youtube video
# Removed develop debug
#
# 23-12-2007:
# Fixed the VLC pid detection and kill system. VLC should now be stoppped when you stop the movie on the Dreambox. Thanks to XX9yCDAS for pointing it out
#
# 16-12-2007:
# Added a trim function and a better vlc pid detecton and kill system. Now all VLC instances should be killed when the movie is stoped
#
# 24-11-2007:
# Added the option to use an alternative codec. mp2v videocodec has been renamed to mpgv on newer linux systems
#
# 07-11-2007:
# Fixed a vlc transcode error. Thanks to Micke for pointing it out!
# Added a vlc pid detection part for better control over what process to kill on the end
# Added the option to turn of the debug
# Added an option to turn of the interface of VLC. This overrules the dreambox setting
#
# 28-10-2007:
# Rewritten the code to the new version 1.7. Third challange image
# First public version
#
# 22-07-2007:
# Initial version based on the second LT image (player version 1.5)
# Made by TheYOSH (http://theyosh.nl/projects/stream2dream-linux/stream2dream-linux - dreambox@theyosh.nl)
#--------------------

use strict;
use IO::Socket;
use Switch;
use Date::Format;
use LWP::Simple;
use threads;
use threads::shared;

# Settings
#Normal port number (should not be changed)
my $port = 9916;
# The IP of the streaming server (Linux box)
my $server = "192.168.5.1";
# The name of the samba share (Not the location)
my $share = "film";
# Change the outputshare to a different place
my $outputshare = $share;
# The location on the disk
my $location = "/mnt/film";
# Output location
my $outputlocation = $location;
# Alternative video codec (If VLC has problems coding video.) Set to 1 to activate
my $alternativecode = 1;
# Location of VLC
my $vlc = "/usr/bin/vlc";
# Default vlc gui, set to dummy to overrule the Dreambox setting
my $vlcgui = "dummy";
# Debug modus, set to 0 to turn debug of
my $debug = 1;

# System variables, should not be changed!
my $transform = "";
my $httpHeader = 0;
my @pids = ();
my $version = "2.5";

my $streamfile = "";
my $progressfile = "";
my $progressthread;
my ($progressloop):shared;

# Start server, open network connection for listening
my $sock = new IO::Socket::INET(
	LocalHost => $server,
	LocalPort => $port,
	Proto => 'tcp',
	Listen => SOMAXCONN,
	Reuse => 1);

$sock or die debugMsg("TCP-Server","no socket: $!");
my($new_sock, $c_addr, $buf);

debugMsg("TCP-Server","Starting listener...");
debugMsg("Info","The 'LT Stream-Player' can connect to us now :-)");

# Loop unlimited times for server requests
while (($new_sock, $c_addr) = $sock->accept())
{
	my ($client_port, $c_ip) =sockaddr_in($c_addr);
	my $client_ipnum = inet_ntoa($c_ip);
	my $client_host = gethostbyaddr($c_ip, AF_INET);
	debugMsg("TCP-Server","Client: $client_ipnum logged in");

	while (defined ($buf = <$new_sock>))
	{
		$buf = trim($buf);
		my $cmdnr = substr($buf,0,1);
		my $output = "";
		my $vlccmd = "";
		my $pid;
		if ($httpHeader < 5) {
			$httpHeader += 1;
			if ($httpHeader == 5) {
				$output = sendHTTPOK();
				print $new_sock $output;
			}
		} else {
			switch ($cmdnr) {
				case 0 {
					# Set the transcode settings
					$streamfile = "\"" . $outputlocation . "/MPStream.ts\"";
					$progressfile = $outputlocation . "/progress.txt";
					my $start = index($buf,"\$-I")+3;
					if ($vlcgui ne "dummy") { $vlcgui = substr($buf,$start,index($buf," \$\$ ")-$start); }
					$transform = substr($buf,index($buf,":sout"));
					$transform =~ s/dst=\$/dst=$streamfile/;
					if ($alternativecode > 0) { $transform =~ s/mp2v/mpgv/; } # Dreambox wants mp2v codec, but codec has been changed to mpgv in newer linux versions)
					$output = "ok\$$version\$mount -t cifs //\$/$share /tmp/mp -o ro,nolock,rsize=\$r,wsize=\$w,user=\$u,password=\$p; mount -t cifs //\$/$outputshare /tmp/mpstream -o ro,nolock,rsize=\$r,wsize=\$w,user=\$u,password=\$p###";
				}
				case 1 {
					# Play the selected movie
					my $lMovieSize = 0;
					$vlccmd = $vlc . " -I $vlcgui ";
					my $file = substr($buf,1);
					if ( index($file,"youtube") != -1 ) {
						# YouTube
						$file = getYouTubeVideoUrl($file);
						$vlccmd .= "\"" . $file . "\" ";
					} elsif ( substr($file,0,7) == "*http://" ) {
						$vlccmd .= "\"" . substr($file,1) . "\" ";
					} elsif ( index($file,"play.dvd.avi") != -1) {
						# DVD Movie
						$file = getDVDUrl($location . "/" . $file);
						$vlccmd .= "\"" . $file . "\" ";
					} else {
						# Default operation
						$lMovieSize = -s $location . "/" . $file;
						$vlccmd .= "\"file://" . $location . "/" . $file . "\" ";
					}
					$vlccmd .= "\"" . $transform . "\" ";
					$vlccmd = $vlccmd . "> /dev/null 2>/dev/null ";
					debugMsg("vlc","CMD: $vlccmd");
					$vlccmd = $vlccmd . "&";
					$output = "ok###";
					system($vlccmd);
					my $getVLCpidCMD = "ps fax -o pid -o cmd | grep vlc | grep \"" . $file . "\" | grep -v grep";
					debugMsg("vlc","Movie: $file");
					my $data = readpipe $getVLCpidCMD;

					foreach $pid (split(/\n/,$data)) {
						my @piddata = split(/ /,trim($pid));
						push(@pids,$piddata[0]);
					}

					# Start the progress thread....
					$progressloop = 1;
					$progressthread = threads->new(\&updateProgress, $lMovieSize );
				}
				case 2 {
					# Exit current movie...
					$progressloop = 0;
					foreach $pid (@pids) {
						system("kill " . $pid . " &");
					}
					@pids = ();
					system("rm -f $outputlocation/MPStream.ts");
					system("rm -f $progressfile");
					$output = "ok###";
				}
				case 9 {
					debugMsg("TCP-Server","Client: $client_ipnum logged out");
					$output = "ok###";
					$httpHeader = 0;
				}
			}
		}
		print $new_sock $output;
	}
}

sub updateProgress() {
	my $pTargetSize = $_[0];
	my $percentage = 0;

	while ($progressloop) {
		my $lStreamFileSize = -s substr($streamfile,1,-1);
		my $progressstring = round($lStreamFileSize/1024/1024);
		if ($pTargetSize != 0) {
			$percentage = round($lStreamFileSize/$pTargetSize*100);
			$progressstring =  $progressstring . "-" . $percentage;
		}
		open (PROGRESSFILE, ">$progressfile");
		print PROGRESSFILE $progressstring;
		close (PROGRESSFILE);

		if ($percentage == 100) {
			# File is converted.... stop running....
			$progressloop = 0;
		}
		sleep (1);
	}
}

sub getYouTubeVideoUrl {
	my $lWatchLocation = $_[0];
	my $YouTubeContent = get $lWatchLocation;
	my $lStart = index($YouTubeContent,", \"t\": \"");
	$lStart += 8;
	my $lStop =  index($YouTubeContent,"\", \"hl\":");
	my $cookieID = substr($YouTubeContent,$lStart,$lStop-$lStart);

	$lStart = index($lWatchLocation,"watch?v=");
	$lStart += 8;
	my $videourl = "http://youtube.com/get_video?video_id=" . substr($lWatchLocation,$lStart) . "&t=" . $cookieID;
	return $videourl;
}

sub getDVDUrl {
	my @lFolders = split(/\//,$_[0]);
	pop(@lFolders); # Remove the play.vob file
	my $lReturnValue = "dvdsimple://";
	my $lFolder;
	foreach $lFolder (@lFolders) {
		$lReturnValue .= "/" . $lFolder;
	}
	return $lReturnValue . "/VIDEO_TS";
}

sub debugMsg {
	my ($pSystem,$pMessage,$pPriority) = ($_[0], $_[1],1);
	print time2str("%d-%m-%Y %H:%M:%S",time) . " [$pSystem] $pMessage\n";
}

sub sendHTTPOK
{
	return "HTTP/1.0 200 OK\nServer: LT-Stream2Dream (Linux)\nDate: " . time2str("%d-%m-%Y %H:%M:%S", time) . "\nContent-Type: text/html\nAccept-Ranges: bytes\nContent-Length: 2\n\nok";
}

sub round {
    my($number) = shift;
    return int($number + .5 * ($number <=> 0));
}

sub trim
{
	my $string = $_[0];
	$string =~ s/^\s+//;
	$string =~ s/\s+$//;
	return $string;
}

