#!/usr/bin/perl -w
# -------------------------------------------------------------------------
#
# tumblerd - daemon to listen for unlock requests on a UDP port and 
#            run a command (typically to open a hole in a firewall)
#
# Copyright (c) 2004 John Graham-Cumming
#
#   This file is part of tumbler
#
#   tumbler 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.
#
#   tumbler 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 tumbler; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
#
# -------------------------------------------------------------------------

use strict;
use IO::Socket::INET;
use Getopt::Long;
use Digest::SHA qw(sha256_hex);

# The version number of this program

my $version = '0.1.0';

# This is the UDP port on which we will listen for attempts to unlock
# one of the services defined in the config file.  By default it is not
# set and must be set with the --port command line option or through
# the [common] section in the config file (port = 1234)

my $port;

# This is the name of the configuration file to load and it can be changed
# using the --config command line option.

my $config = '/etc/tumblerd.conf';

# This hash contains the configuration information for each door specified
# in the config file.  Each door section looks like this:
#
# [door-X]
#   secret = Y
#   command = Z
#
# and is mapped to an entry in the door hash as follows
#
# $doors{X}
# $doors{X}{secret} = Y
# $doors{X}{command} = Z
# $doors{X}{last} contains the last hash that was used for this
#                 door
#
# Note that the command can contain the following:
#
# %IP% which will be the IP address of the machine opening the door
# %NAME% the name of the door

my %doors;

# This contains a list of hashes that have recently been used and is
# designed to prevent us from doing a command more than once without
# a minute having passed (which will change the hash).  Initialize it
# with the depth of queue we should keep.

my @recent_hashes = ( '', '', '', '', '' );

# Name of a log file to write to, leave unset for no logging, set
# log = X in the [common] section of the config file

my $log;

# -----------------------------------------------------------------------
#
# write_log
#
# Write a message to the log file, if the log file is specified
#
# -----------------------------------------------------------------------
sub write_log
{
    my ( $message ) = @_;

    if ( defined( $log ) ) {
        if ( open LOG, ">>$log" ) {
            print LOG scalar localtime, ": $message\n";
            close LOG;
        } else {
            print STDERR "Unable to write to log '$log'\n";
        }
    }
}

# -----------------------------------------------------------------------
#
# read_configuration
#
# Reads the configuration file and parses common options and then 
# setups for individual 'doors' (i.e. commands that can be executed
# remotely).
#
# Returns 1 if successful, or 0 if error
#
# -----------------------------------------------------------------------
sub read_configuration
{
    # The configuration file consists of two section types: common
    # and door.  common contains configuration options for the entire
    # program (e.g. port to specify the UDP port) and each door contains
    # configuration for a single command (contains the shared secret,
    # a friendly name for the door and the command to run)

    if ( open CFG, "<$config" ) {
        my $section = '';
        my $error = 0;
        my $line = 0;
        my $door;
        while ( <CFG> ) {
            my $val = $_;
            $val =~ s/#.+//;
            $val =~ s/^\s+//;
            $val =~ s/[\s\r\n]+$//;
            $line++;

            if ( $val eq '' ) {
                next;
            }

            if ( $val =~ /^\[common\]$/ ) {
                $section = 'common';
                next;
            }

            if ( $val =~ /^\[door-(.+)\]$/ ) {
                $section = 'door';
                $door = $1;
                if ( defined( $doors{$door} ) ) {
                    print STDERR "Only one [door-$door] section is allowed; ";
                    print STDERR "door names must be unique\n";
                    $error = 1;
                    last;
                }
                next;
            }

            if ( $section eq '' ) {
                print STDERR "The configuration file must start with a ";
                print STDERR "valid section name, either [common] or ";
                print STDERR "[door-X]\n";
                $error = 1;
                last;
            }

            if ( $val =~ /([a-z]+)\s*=\s*(.+)/ ) {
                if ( $section eq 'common' ) {
                    if ( $1 eq 'port' ) {
                        $port = $2;
                        next;
		    } elsif ( $1 eq 'log' ) {
                        $log = $2;
                        next;
                    } else {
                        print STDERR "The valid options in the common section ";
                        print STDERR "are 'port = X' and 'log = X'; don't ";
                        print STDERR "understand '$val'\n";
                        $error = 1;
                        last;
                    }
                } else {
                    if ( $1 eq 'secret' ) {
                        $doors{$door}{secret} = $2;
                        next;
                    } elsif ( $1 eq 'command' ) {
                        $doors{$door}{command} = $2;
                        next;
                    } else {
                        print STDERR "In a door section the valid options ";
                        print STDERR "are 'secret' and 'command'; don't ";
                        print STDERR "understand '$val'\n";
                        $error = 1;
                        last;
                    }
                }
            } else {
                print STDERR "A valid line in a configuration file section ";
                print STDERR "is in the form 'foo = bar'.  Unable to understand ";
                print STDERR "'$val'\n";
                $error = 1;
                last;
            }
        }
        close CFG;

        if ( $error ) {
            print STDERR "$config line $line\n";
        }

        return !$error;
    }

    print STDERR "Failed to open configuration file '$config'\n";
    return 0;
}

# -----------------------------------------------------------------------
#
# parse_command_line
#
# Parses the command line options and returns 1 if successful
#
# -----------------------------------------------------------------------
sub parse_command_line
{
    my $help = 0;

    if ( !GetOptions( 'config=s'   => \$config,
                      'port=i'     => \$port,
                      'help'       => \$help ) ) {
        return 0;
    }

    # Handle getting help

    if ( $help ) {
        print "tumblerd v$version - daemon that implements the tumbler protocol\n";
        print "\nOptions:\n";
        print "\n--port          Set the UDP port to listen on";
        print "\n--config        Set the config file to load\n";
        exit 0;
    }

    return 1;
}

# -----------------------------------------------------------------------
#
# validate_setup
#
# Checks the configuration of tumbler for errors, returns 1 if 
# everything is ok
#
# -----------------------------------------------------------------------
sub validate_setup
{
    if ( !defined( $port ) ) {
        print STDERR "The UDP port to listen on must be specified ";
        print STDERR "with either the --port command line option, or in ";
        print STDERR "the [common] section of the config file '$config' ";
        print STDERR "by specifying port = X\n";

        return 0;
    }

    # Check that each door has a secret and a command

    foreach my $door (keys %doors) {
        if ( !defined( $doors{$door}{secret} ) ) {
            print STDERR "door '$door' does not have a secret defined. ";
            print STDERR "Define the secret in the appropriate [door-$door] ";
            print STDERR "section of the config file '$config'\n";

            return 0;
        }

        if ( !defined( $doors{$door}{command} ) ) {
            print STDERR "door '$door' does not have a command defined. ";
            print STDERR "Define the command in the appropriate [door-$door] ";
            print STDERR "section of the config file '$config'\n";

            return 0;
        }

        $doors{$door}{last} = '';
    }

    return 1;
}

# -----------------------------------------------------------------------
#
# run_tumbler
#
# Run the tumbler process waiting for UDP packets and responding if
# the appropriate message is sent
#
# Returns an appropriate exit code for the process
#
# -----------------------------------------------------------------------
sub run_tumbler
{
    # Create the UDP socket and then listen for packets on it, when
    # packet is received validate the information in it and if it
    # is valid run the appropriate command to open the 'door'

    my $socket = IO::Socket::INET->new( LocalPort => $port,
                                        Proto     => 'udp' );

    if ( !defined( $socket ) ) {
        print STDERR "Failed to open UDP socket on port $port\n";
        return 1;
    }

    write_log( "tumbler v$version started listening on port '$port'" );

    my $message;
    while ( my $remote = $socket->recv( $message, 255 ) ) {

        # A valid message consists of TUMBLER1: followed by a SHA256
        # hash

        if ( $message =~ /^TUMBLER1: ([a-f0-9]+)/i ) {
            write_log( "Received tumbler message '$message'" );

            # $1 now contains the hash the the remote has sent us
            # we need to compare this against appropriate hashes
            # for the doors that we are configured for.
            #
            # The hash is formed from the following information
            #
            # 1. The current zulu time and date in minutes
            # 2. The sending IP address
            # 3. Each door's secret
            #
            # If we get a match we open the door

            my $hash = $1;
            my ($sec,$min,$hour,$mday,$mon,$year) = gmtime(time);
            my ($sender_port, $sender_ip ) = sockaddr_in( $socket->peername );
            my $remote = inet_ntoa( $sender_ip );
            my $base = "$year$mon$mday$hour$min:$remote:";

            foreach my $door (keys %doors) {
                if ( $hash eq sha256_hex( $base . $doors{$door}{secret} ) ) {

                    # Don't do this if we have already used this hash

		    if ( $hash eq $doors{$door}{last} ) {
                        write_log( "Rejecting duplicate hash '$hash' on [door-$door]" );
                        next;
		    }

                    # The following keywords can be used in the command
                    # and are substituted at this point:
                    #
                    # %IP%        IP address of the connecting machine
                    # %NAME%      Name of the door being opened

                    my $command = $doors{$door}{command};
                    $command =~ s/%IP%/$remote/g;
                    $command =~ s/%NAME%/$door/g;

                    # Record the hash as having been used recently

                    $doors{$door}{last} = $hash;

                    write_log( "Executing [door-$door] command '$command'" );

                    system( $command );
                }
            }
        }
    }

    return 0;
}

# MAIN

my $result = 1;

if ( parse_command_line() ) {
    if ( read_configuration() ) {
        if ( validate_setup() ) {
            $result = run_tumbler();
            write_log( "tumbler terminated" );
        }
    }
}

exit $result;
