#!/usr/bin/perl
use warnings;
use Socket;
use Carp;
use Encode qw/from_to/;
use XML::Parser;
use POSIX qw/strftime setuid setgid getuid getgid/;

$stream=undef;

sub handle_start
 {
  $_[0]->{'LAST_TAG'}=$_[1];
  if ($_[1] eq 'record' && $_[2] eq 'command')
   {
    $_[0]->{'TAG_HASH'}->{'command'}=$_[3];
   }
  elsif ($_[1] eq 'audiopids' && $_[2] eq 'selected')
   {
    $_[0]->{'TAG_HASH'}->{'audiopid'}=$_[3];
   }
 }
sub handle_end
 {
  my ($self,$name)=@_;
  delete($self->{'LAST_TAG'});
 }
sub handle_text
 {
  if ($_[0]->{'LAST_TAG'})
   {
    my $value=$_[1];
    $value=~tr/\r\n//d;
    $value=~s/^\s*(.*)\s*$/$1/;
    if ($value)
     {
      $_[0]->{'TAG_HASH'}->{$_[0]->{'LAST_TAG'}}=$value;
     }
   }
 }


sub handle_signal
 {
  my $signame = shift;
  mydie("*** Exiting on signal $signame ***\n");
 }

sub REAPER
 {
  while (waitpid(-1,WNOHANG))
   {
    print STDERR "Child process died\n";
   }
 }

sub mydie
 {
  my $msg=$_[0];
  if ($stream && $stream->{'CHILD'})
   {
    kill(1,$stream->{'CHILD'});
    dbox_message($msg,9);
   }
  unlink("/var/run/streaming.pl.PID");
  die $msg;
 }

sub error_message
 {
  my $msg=$_[0];
  print STDERR "ERROR: $msg !\n";
  dbox_message($msg,4);
 }
sub warning_message
 {
  my $msg=$_[0];
  print STDERR "WARNING: $msg !\n";
  dbox_message($msg,2);
 }
sub info_message
 {
  my $msg=$_[0];
  print STDERR "INFO: $msg\n";
  dbox_message($msg,1);
 }


sub early_warning_message
 {
  my ($msg,$iaddr)=@_;
  print STDERR "WARNING: $msg !\n";
  dbox_raw_message($msg,2,$iaddr);
 }

sub dbox_message
 {
  my ($msg,$icon)=@_;
  if (defined($stream))
   {
    dbox_raw_message($msg,$icon,$stream->{'iaddr'});
   }
  else
   {
    print STDERR "Warning: Can't send message to dreambox if \$stream is not defined\n";
   }
 }
sub dbox_raw_message
 {
  my ($msg,$icon,$iaddr)=@_;
  my $fatal='';
  if ($icon>4)
   {
    $fatal='%20FATAL%20ERROR';
    $icon=4;
   }
  $msg=fixchars($msg);
  my $paddr   = sockaddr_in(80, $iaddr);
  $proto   = getprotobyname('tcp');
  socket(SOCK, PF_INET, SOCK_STREAM, $proto)  || die "socket: $!";
  connect(SOCK, $paddr)    || die "connect: $!";
  my $cmd="GET /cgi-bin/xmessage?caption=streaming.pl$fatal&body=$msg&timeout=5&icon=$icon HTTP/1.0\r\n\r\n";
#  my $dbox=inet_ntoa($iaddr);
#  print "Sending request to $dbox:\n$cmd";
  syswrite(SOCK,$cmd);
  my $ok=0;
  while(<SOCK>)
   {
    tr/\r\n//d;
    if ($_ eq '+ok')
     {
      $ok=1;
      last;
     }
   }
  close SOCK; 
  unless ($ok)
   {
    print STDERR "Failed to send error message to dreambox\n";
   }
  return;
 }

sub fixchars
 {
  my $str=$_[0];
  my $out='';
  for my $i (0..length($str)-1)
   {
    my $c=substr($str,$i,1);
    if ($c=~/^[\w_-]$/)
     {
      $out.=$c;
     }
    else
     {
      $out.=sprintf("%%%02x",ord($c));
     }
   }
  return $out;
 }



my $daemon=0;
my $debug=0;
my $setuser;
my $port = 4000;
my $srvip = "192.168.0.1";
my $dir="/hdc1/video/dreambox/movie";
while(my $a=shift @ARGV)
 {
  if ($a eq '-F')
   {
    $daemon=1;
    next;
   }
  if ($a eq '-D')
   {
    $debug=1;
    next;
   }
  if ($a eq '-u')
   {
    $setuser=shift @ARGV;
    next;
   }
  if ($a eq '-p')
   {
    $port=shift @ARGV;
    next;
   }
  if ($a eq '-l')
   {
    $srvip=shift @ARGV;
    next;
   }
  if ($a eq '-d')
   {
    $dir=shift @ARGV;
    next;
   }
  else
   {
    print "usage: streaming.pl [-F] [-D] [-u <user>] [-p <port>] [-l <listen IP address>] [-d <target dir>]\n"; 
    exit 1;
   }
 } 

if ($daemon)
 {
  if (fork())
   {
    exit 0;
   }
 }

my $pidfn="/var/run/streaming.pl.PID";
if (open(P,">$pidfn"))
 {
  print P $$,"\n";
  close P;
 }

if ($setuser)
 {
  if (my ($name,$passwd,$uid,$gid,$quota,$comment,$gcos,$dir,$shell,$expire) = getpwnam($setuser))
   {

     chown($uid,$gid,$pidfn);
     setgid($gid);
     setuid($uid);
     if (getuid() != $uid || getgid() != $gid)
      {
       die "Failed to switch to user $setuser (UID $uid, GID $gid)\n";
      }
   }
  else
   {
    die("Can't find user  \"$setuser\"");
   }
 }



my $proto = getprotobyname('tcp');


my @signals=('HUP','INT','QUIT','TRAP','ABRT','BUS','KILL','TERM','PIPE','SEGV');
for my $s (@signals)
 {
  $SIG{$s}=\&handle_signal;
 }
#$SIG{'CHLD'}=\&REAPER;

my $siaddr   = inet_aton($srvip);
socket(Server, PF_INET, SOCK_STREAM, $proto)        || die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR,
                                    pack("l", 1))   || die "setsockopt: $!";
#bind(Server, sockaddr_in($port, INADDR_ANY))        || die "bind: $!";
bind(Server, sockaddr_in($port, $siaddr))        || die "bind: $!";
listen(Server,SOMAXCONN)                            || die "listen: $!";

print "server started on IP $srvip, port $port\n";


my $streamport=31339;
my $httpport=80;

while (1)
 {

  my $paddr = accept(Client,Server);
  my($port,$iaddr) = sockaddr_in($paddr);
  my $name = gethostbyaddr($iaddr,AF_INET);
  my $dbox=inet_ntoa($iaddr);
  print "connection from $name \[$dbox\]\n";
  my $buffer='';
  sysread(Client,$buffer,32768);
  close Client;
  if ($buffer eq '')
   {
    early_warning_message("Empty string received",$iaddr);
    next;
   }
  from_to($buffer,'utf8','iso8859-2');
  $buffer=~tr/ÁáÈèÏïÉéËëÚúÍíÜüÔô¥µÅåÒòÓóÖöÄäØø©¹«»ÙùÇçÌìÝý®¾/AaCcDdEeEeUuIiUuOoLlLlNnOoOoAaRrSsTtUuCcEeYyZz/;
#  print "Received: $buffer\n";
  if (open(F,">/tmp/streaming_command_$$.xml"))
   {
    print F $buffer;
    close F;
   }
  my $parser = new XML::Parser() || mydie "Can't create XML parser";
  $parser->setHandlers(Char=>\&handle_text,Start=>\&handle_start,End=>\&handle_end);
  $parser->{'TAG_HASH'}={};
  eval
   {
    $parser->parse($buffer,-style=>'Tree',ErrorContext => 3);
   };
  if ($@)
   {
    print STDERR "ERROR: Can't parse XML:\n$buffer\n - $@";
    dbox_raw_message("Can't parse XML command",4,$iaddr);
    next;
   }
  my $cmd=$parser->{'TAG_HASH'};
  my $command;
  unless ($command=$cmd->{'command'})
   {
     early_warning_message("No command received",$iaddr);
     next;
   }
  print "Received command: $command\n";
  if ($command eq 'record')
   {
    if ($stream)
     {
      warning_message("Recording already started");
      next;
     }
    $stream={'iaddr'=>$iaddr};
    my @reqdata=('channelname','epgtitle','videopid','audiopid');
    for my $req (@reqdata)
     {
      unless ($cmd->{$req})
       {
        warning_message($stream,"Reqired field missing in received command: $cmd");
        $stream=undef;
        next;
       }
      $stream->{'cmd'}=$cmd;
     }
    my $fnbase=strftime("%Y-%m-%d_%H-%M-%S",localtime(time));
    my $channel=$cmd->{'channelname'};
    $channel=~s/^\s+//;
    $channel=~s/\s+$//;
    my $title=$cmd->{'epgtitle'};
    my @t=split(/-/,$title);
    $title=$t[0]; 
    $title=~s/^\s+//;
    $title=~s/[\s_]+$//;
    $fnbase.='_'.$channel.'_'.$title;
    $fnbase=~tr/ \/\\$/____/;
    $fnbase=$dir.'/'.$fnbase.'.mpeg';
    my $apid=sprintf("%x",$cmd->{'audiopid'});
    my $vpid=sprintf("%x",$cmd->{'videopid'});
    print "Executing mencoder to create \"$fnbase\"\n";
    my $pid;
    unless ($pid=fork)
     {
      exec("/opt64/mplayer/bin/mencoder 'http://$dbox:31339/$apid,$vpid' -oac copy -ovc copy -of mpeg -mpegopts format=dvd:tsaf -quiet -o \"$fnbase\"");
      exit;
     }
    $stream->{'CHILD'}=$pid;
    info_message("Recording started");
   }
  elsif ($command eq 'stop')
   {
    unless ($stream)
     {
      early_warning_message("No recording to stop",$iaddr);
      next;  
     }
    my $pid=$stream->{'CHILD'};
#    $SIG{'CHLD'}='DEFAULT';
    print "Stopping mencoder (PID $pid)\n";
    kill(1,$pid);
    waitpid($pid,0);
    $stream->{'CHILD'}=undef;
#    for my $s (@signals)
#     {
#      $SIG{$s}='DEFAULT';
#     }
    print "mencoder stopped\n";
    info_message("Recording stopped");
    $stream=undef;
   }
  else
   {
    early_warning_message("Unrecognized command: \"$command\"",$iaddr);
   }
 }
exit;