#!/usr/bin/perl
# $Id: glotvd 320 2008-09-17 11:09:22Z bd $

# Copyright 2004-2008 Bjorn Danielsson
# http://glotv.dax.nu/
#
# This file is part of GLOTV. GLOTV is free software; you can redistribute
# it and/or modify it under the terms of the GNU General Public License as
# published at this URL: http://www.gnu.org/licenses/gpl.html.

use vars qw(%config);
use Getopt::Long;
use Socket;
use FileHandle;
use Time::HiRes qw(sleep);
use POSIX;
use strict;

my $PATHPREFIX = "/usr/local/glotv";

my $config_file = "$PATHPREFIX/etc/glotv.conf";
my $opt_port = undef;
my $debug = undef;

GetOptions('port=s'  => \$opt_port,
	   'debug'   => \$debug,
	   );

$config_file = $ARGV[0] if defined $ARGV[0];

do $config_file or die "Failed reading configuration file";

my $ip_allowed = $config{ip_allowed} || "192.168.0.0/16";
my $movieroot = $config{movieroot} || "/home/video";
my $fmt_capture = $config{capture_hook} || "echo capture_hook not defined";
my $fmt_tv_input = $config{tv_input_hook} || "echo tv_input_hook not defined";
my $fmt_rca_input = $config{rca_input_hook} || "echo rca_input_hook not defined";
my $fmt_dvb_input = $config{dvb_input_hook} || "echo dvb_input_hook not defined";
my $fmt_status = $config{status_hook} || "echo status_hook not defined";
my $pidfile_path = $config{capture_pidfile} || "/tmp/capture.pid";
my %MHz = ();
my $rca_channel = undef;
my %DVB = ();
my $OBSOLETE_USBREPLAY_KLUDGE = 0;		# Turn this on if you use the libusb driver

if ($config{frequencies}) {
    my $table = $config{frequencies};
    foreach (keys %$table) {
	my ($mhz,$data) = split(/\s+/, $$table{$_}, 2);
	if ($mhz =~ m/^rca$/i) {
	    $rca_channel = $_;
	} elsif ($mhz =~ m/^dvb$/i) {
	    $DVB{$_} = $data;
	} else {
	    $MHz{$_} = $mhz;
	}
    }
}

my $sockname = $config{sockname} || "/tmp/glotv.sock";

$opt_port = $config{tcp_port} unless defined $opt_port;

unless ($sockname || $opt_port) {
    die "Neither TCP socket or unix socket in configuration";
}

my ($netname,$nbits) = split('/', $ip_allowed);
my $ipaddr = unpack("N", inet_aton($netname));
my $netmask = 0;
$netmask = ~ ((1 << 32-$nbits) - 1) if $nbits > 0;

my $select_rbits = "";
my $select_wbits = "";

my $fd_usock = undef;
my $fd_isock = undef;
my $fd_mpeg = undef;
my @fd_conns = ();
my %fh_conn = ();
my %mpeg_queue = ();
my %bad_client = ();
my $fd_locking_client = -1;		# -1 means channel is not locked
					# -2 means locked for the next client
					# otherwise the number is the client fd

my $mpegbufsize = 32768;
my $maxqueuelimit = 1000;

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

sub init_unix_socket {
    socket(USOCK, PF_UNIX, SOCK_STREAM, 0) or die "Couldn't create socket: $!";
    unlink($sockname);
    bind(USOCK, sockaddr_un($sockname)) or die "Couldn't bind socket: $!";
    listen(USOCK, SOMAXCONN);
    $fd_usock = USOCK->fileno();
}

sub init_inet_socket {
    my $tcp_proto = getprotobyname("tcp");
    socket(ISOCK, PF_INET, SOCK_STREAM, $tcp_proto) or die "Couldn't create socket: $!";
    setsockopt(ISOCK, SOL_SOCKET, SO_REUSEADDR, pack("i",1));
    bind(ISOCK, sockaddr_in($opt_port, INADDR_ANY)) or die "Couldn't bind socket: $!";
    listen(ISOCK, SOMAXCONN);
    $fd_isock = ISOCK->fileno();
}

sub access_allowed {
    my $fh = shift;
    my ($port,$iaddr) = sockaddr_in(getpeername($fh));
    my $client_ip = unpack("N", $iaddr);
    if (($client_ip & $netmask) == $ipaddr) {
	return 1;
    }
    close($fh);
    print STDERR "remote access denied for client ", inet_ntoa($iaddr), ":$port\n";
    return 0;
}

sub open_conn {
    my $fh = shift;
    fcntl($fh, F_SETFL, O_NONBLOCK) or die "fcntl() failed: $!\n";
    setsockopt($fh, SOL_SOCKET, SO_SNDBUF, pack("i",$mpegbufsize));
    my $fd = $fh->fileno();
    vec($select_rbits, $fd, 1) = 1;
    $fh_conn{$fd} = $fh;
    push @fd_conns, $fd;
}

sub close_conn {
    my $fd = shift;
    print STDERR "close_conn($fd), filehandle=", *{$fh_conn{$fd}}, "\n" if $debug;
    if ($mpeg_queue{$fd}) {
	delete $mpeg_queue{$fd};
    }
    vec($select_rbits, $fd, 1) = 0;
    vec($select_wbits, $fd, 1) = 0;
    close($fh_conn{$fd});
    delete $fh_conn{$fd};
    @fd_conns = keys %fh_conn;
    if ($fd == $fd_locking_client) {
	$fd_locking_client = -1;
    }
}

sub open_capture {
    my $channel = shift;
    my $mhz = "599.25";
    if ($channel =~ m/^(\d+\.\d+)/) {
	$mhz = $1;
    } elsif ($MHz{$channel}) {
	# This never happens, seriously
	$mhz = $MHz{$channel};
    } elsif ($DVB{$channel}) {
	# And neither does this...
	$mhz = $DVB{$channel};
    }
    my $cmd = sprintf("$fmt_capture", $mhz);
    print STDERR "$cmd\n";
    unlink $pidfile_path;
    open MPEG, "$cmd|" or die "Couldn't start capture process: $!";
    #my $dummybuf = "";
    #sysread(MPEG, $dummybuf, $mpegbufsize);
    fcntl(MPEG, F_SETFL, O_NONBLOCK) or die "fcntl() failed: $!\n";
}

sub close_capture {
    vec($select_rbits, $fd_mpeg, 1) = 0;
    $fd_mpeg = undef;
    close(MPEG);
}

sub stop_capture {
    if (open PIDFILE, "<${pidfile_path}") {
	my $pid = <PIDFILE>;
	close(PIDFILE);
	kill 'SIGTERM', $pid if $pid =~ m/^\d+$/;
	print STDERR "sent SIGTERM to capture process, please wait...\n";
	sleep 0.1;
    }
    &close_capture();
}

# Command dispatcher for the GLOTV protocol.
# 
# The available commands are:
#
#    "file <PATH>"
#    "play"
#    "play_locked"
#    "channel <FREQ>"
#    "channel_lock"
#    "list_channels"
#    "status"

sub command {
    my $fd = shift;
    my $cmd = shift;
    print STDERR "command($fd, $cmd)\n" if $cmd ne 'status' || $debug;
    
    if ($cmd =~ m/^file (\S+)$/i) {
	my $path = $1;
	if (grep m{^\.}, split("/", $path) or $path =~ m{^/}) {
	    &close_conn($fd);
	}
	my $fh = $fh_conn{$fd};
	fcntl($fh, F_SETFL, 0);			# Turn off O_NONBLOCK
	my $pid = fork();
	if ($pid == 0) {
	    print STDERR "Opening $movieroot/$path\n";
	    open(MOVIE, "<$movieroot/$path") or die "Couldn't open movie file: $!"; 
	    close(STDOUT);
	    my $buf = "";
	    while (1) {
		last unless read(MOVIE, $buf, 32768);
		last unless print $fh $buf;
	    }
	    close(STDOUT);
	    close(MOVIE);
	    exit(0);
	}
	&close_conn($fd);
    } elsif ($cmd =~ m/^play(_locked)?$/i) {
	$fd_locking_client = $fd if $1;
	$mpeg_queue{$fd} = [];
        if (!$fd_mpeg) {
	    &open_capture(175.25);		# Kludge: need a NICAM signal here for some reason...
	    $fd_mpeg = MPEG->fileno();
	    vec($select_rbits, $fd_mpeg, 1) = 1;
	}
    } elsif ($cmd =~ m/^channel(_lock)? (\S+)$/i) {
	my $lockit = $1;
	my $channel = $2;
	&close_conn($fd);
	if ($lockit || $fd_locking_client == -1) {
	    $fd_locking_client = -2 if $lockit;
	    if ($OBSOLETE_USBREPLAY_KLUDGE && !$fd_mpeg) {
		&open_capture(175.25);		# Kludge: need a NICAM signal here for some reason...
		$fd_mpeg = MPEG->fileno();
		vec($select_rbits, $fd_mpeg, 1) = 1;
	    }
	    if (defined($rca_channel) && $channel eq $rca_channel || $channel =~ m/^(rca|composite)$/i) {
		system($fmt_rca_input);
	    } else {
		my $fmt = $fmt_tv_input;
		my $mhz = "599.25";
		if ($channel =~ m/^(\d+\.\d+)/) {
		    $mhz = $1;
		} elsif ($MHz{$channel}) {
		    $mhz = $MHz{$channel};
		} elsif ($DVB{$channel}) {
		    $fmt = $fmt_dvb_input;
		    $mhz = $DVB{$channel};
		}
		system(sprintf($fmt, $mhz));
	    }
	}
    } elsif ($cmd =~ m/^list_channels$/i) {
	my $fh = $fh_conn{$fd};
	fcntl($fh, F_SETFL, 0);			# Turn off O_NONBLOCK
	my $pid = fork();
	if ($pid == 0) {
	    close(STDOUT);
	    my $table = $config{frequencies};
	    if ($table) {
		foreach (sort {$a <=> $b} keys %$table) {
		    print $fh "$_ $$table{$_}\n";
		}
	    }
	    exit(0);
	}
	&close_conn($fd);
    } elsif ($cmd =~ m/^status/i) {
	my $fh = $fh_conn{$fd};
	fcntl($fh, F_SETFL, 0);			# Turn off O_NONBLOCK
	my $pid = fork();
	if ($pid == 0) {
	    close(STDOUT);
	    print $fh "channel_lock ", ($fd_locking_client == -1? 0 : 1), "\n";
	    print $fh `$fmt_status`;
	    exit(0);
	}
	&close_conn($fd);
    }
}

&init_unix_socket() if $sockname;
&init_inet_socket() if $opt_port;

vec($select_rbits, $fd_usock, 1) = 1 if defined $fd_usock;
vec($select_rbits, $fd_isock, 1) = 1 if defined $fd_isock;

my $timeout = 10;

sub sysread_mpeg {
    my $newbuf = "";
    my $n = sysread(MPEG, $newbuf, $mpegbufsize);
    return ($n, \$newbuf);
}

while (1) {
    my $rout = $select_rbits;
    my $wout = $select_wbits;
    my $nfound = select($rout, $wout, undef, $timeout);
    if (!defined($nfound)) {
	die "Hmm, strange error";
    } elsif ($nfound) {
	foreach my $fd (@fd_conns) {
	    if (vec($wout, $fd, 1)) {
		my $queue = $mpeg_queue{$fd};
		my ($offset,$bufref) = @$queue;
		my $currentsize = length($$bufref);
		if ($offset == $currentsize) {
		    &close_conn($fd);
		} else {
		    my $n = syswrite($fh_conn{$fd}, $$bufref, $currentsize, $offset);
		    if (!defined($n)) {
			print STDERR "error from syswrite($fd), $!\n";
			&close_conn($fd) unless $! == EAGAIN;
		    } elsif ($n < $currentsize - $offset) {
			$$queue[0] = $offset + $n;
		    } else {
			shift @$queue;		# remove old offset
			shift @$queue;		# and old buffer ref
			vec($select_wbits, $fd, 1) = 0 unless @$queue;
		    }
		}
	    }
	    if (vec($rout, $fd, 1)) {
		my $fh = $fh_conn{$fd};		# Must check if this is still defined, since
		if (defined($fh)) {		# it could have been closed after syswrite.
		    my $line = <$fh>;
		    if (defined($line)) {
			chomp $line;
			&command($fd, $line);
		    } else {
			my $errno = $! + 0;
			unless ($! == EAGAIN) {
			    if ($errno == 0) {
				print STDERR "eof on fd $fd\n";
			    } else {
				print STDERR "exception on fd $fd: $errno ($!)\n";
			    }
			    &close_conn($fd);
			}
		    }
		}
	    }
	}
	if ($fd_mpeg && vec($rout, $fd_mpeg, 1)) {
	    my ($n,$bufref) = &sysread_mpeg();
	    if (!defined($n)) {
		&close_capture() unless ($! == EAGAIN);
	    } elsif ($n == 0) {
		&close_capture();
	    } else {
		my $fd = undef;
		my $queue = undef;
		while (($fd,$queue) = each %mpeg_queue) {
		    if (@$queue < $maxqueuelimit) {
			vec($select_wbits, $fd, 1) = 1 if @$queue == 0;
			push @$queue, 0, $bufref;
		    } else {
			print STDERR "buffer queue limit exceeded for fd $fd, resetting queue.\n";
			$mpeg_queue{$fd} = [$$queue[0],$$queue[1]];
			$bad_client{$fd} = time;		# Currently not used...
		    }
	        }
	    }
	}
	if (vec($rout, $fd_usock, 1)) {
	    my $fh = new FileHandle;
	    if (accept($fh, USOCK)) {
		&open_conn($fh);
	    }
	}
	if (vec($rout, $fd_isock, 1)) {
	    my $fh = new FileHandle;
	    if (accept($fh, ISOCK)) {
		&open_conn($fh) if &access_allowed($fh);
	    }
	}
    }
    if ($fd_mpeg && !%mpeg_queue) {
	&stop_capture();		# Turn off capturing when idle
    }
    if ($nfound == 0) {
	if ($fd_mpeg) {
	    print STDERR "select() timed out... has the capturing device been turned off?\n";
	}
	foreach my $fd (@fd_conns) {
	    &close_conn($fd);
	}
    }
}

