#!/usr/bin/perl

# TeleCam CGI client
# http://fastolfe.net/features/telecam/
#
# Copyright (c) 2000 David Nesting <david@fastolfe.net>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published
# by the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
# General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software Foundation,
# Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
#
# Uses the telecam.pl client to send a message to the Mindstorms RCX.
#
# Tab stops at 4, please.

use strict;
use Socket;

# Set to the path to your telecam.pl client (with arguments if necessary)
#my @TELECAM = qw{ /home/fastolfe/bin/telecam.pl -h anomaly.intranet };
my @TELECAM = qw{ /usr/local/bin/telecam.pl };

# If you want to be able to ban people, put their hostnames/IP's in
# this file, one per line, shell wildcards permitted.
my $BAN_FILE = "telecam.bans";

# If you want people from this CGI script to send R commands
# (reset camera position to neutral), set this.
my $ALLOW_RESET = 1;

# If you want people from this CGI script to send M commands (mark
# current camera position as neutral), set this.
my $ALLOW_MARK = undef;

# Redirect the users here when we're done.
my $REDIRECT = $ENV{'HTTP_REFERER'};

# ---

$|=1;
my $message = shift || $ENV{QUERY_STRING};

unless (-x $TELECAM[0]) {
	print STDERR "$0: Cannot execute $TELECAM[0]\n";
	exit 255;
}

my @bans;

if ($BAN_FILE) {
	if (open(F, "<telecam.bans")) {
		while (<F>) {
			chop;
			next if /^\s*#/ || /^\s*$/;
			push(@bans, $_);
		}
		close(F);
	}
	
	unless ($ENV{REMOTE_HOST} =~ /[a-zA-Z]/) {
		unless ($ENV{REMOTE_ADDR}) {
			$ENV{REMOTE_ADDR} = "127.0.0.1";
		}
	
		if (my $iaddr = inet_aton($ENV{REMOTE_ADDR})) {
			$ENV{REMOTE_HOST} = gethostbyaddr($iaddr, AF_INET);
		} else {
			$ENV{REMOTE_HOST} = $ENV{REMOTE_ADR};
		}
	}
	
	for my $ban (@bans) {
		my $re = &glob2pat($ban);
		if ( ($ENV{REMOTE_HOST} =~ /$re/i) ||
		     ($ENV{REMOTE_ADDR} =~ /$re/i) )
		{
			print qq|Status: 302 Redirect
X-Fastolfe-Rules: http://fastolfe.net/features/telecam/
Location: $REDIRECT

|;
	
			exit 0;
		}
	}
}

unless ((($message eq 'R') && !$ALLOW_RESET) 
	|| (($message eq 'M') && !$ALLOW_MARK)) 
{
	system(@TELECAM, $message);
}

print qq|Status: 302 Redirect
X-Fastolfe-Rules: http://fastolfe.net/features/telecam/
Location: $REDIRECT

|;
sub glob2pat {
	my $globstr = shift;
	my %patmap = (
		'*' => '.*',
		'?' => '.',
		'[' => '[',
		']' => ']',
	);
	$globstr =~ s{(.)} { $patmap{$1} || "\Q$1" }ge;
	return '^' . $globstr . '$';
}