#!/usr/local/bin/perl -w
# -------------------------------------------------------------------------
#
# shimmerd - daemon to 'shimmer' a set of ports to disguise the location
#            of a sensitive service
#
# Copyright (c) 2007-2008 John Graham-Cumming
#
#   This file is part of shimmer
#
#   shimmer 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
#   (at your option) any later version.
#
#   shimmer 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 shimmer; if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
#
# -------------------------------------------------------------------------

# Getting started?
#
# Go read the run_shimmer function and work from there.  The most
# important other functions are open_ports (which does the crypto),
# forward_port (which handles a forwarded connection) and blacklist_ip
# (to cut off bad IP addresses).

use strict;
use IO::Socket::INET;
use IO::Select;
use Getopt::Long;
use Digest::SHA qw(sha256);
use Crypt::Rijndael;

# The version number of this program

my $version = '0.1.0';

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

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

# 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;

# This has contains the ports that are being shimmered (each port is
# referred to as a mirage)

my %mirages;

# Set up handling of the CHLD signal (when a child process dies) and
# the INT signal (when we are being shutdown)

$SIG{CHLD} = \&reaper;
$SIG{INT}  = \&hunter;

# This hash contains the PIDs of all running child processes to that
# they can be killed when we are interrupted.  See the functions
# reaper, hunter and forward_port for use.

my %children;

# This hash contains a list of blacklisted IP addresses, it maps the
# IP addresses to the Unix epoch time of the last connection attempt
# by the IP address.

my %blacklist;

# -----------------------------------------------------------------------
#
# reaper
#
# Reap a dead child process and remove it from the %children hash
#
# -----------------------------------------------------------------------
sub reaper
{
    my $pid = wait;
    
    if ( $pid != -1 ) {
	write_log( "Child process $pid dying" );

	delete $children{$pid};
    }

    $SIG{CHLD} = \&reaper;
}

# -----------------------------------------------------------------------
#
# hunter
#
# We are being interrupted to tell all child processes to die now.
# This function will actually perform the exit for the entire program.
#
# -----------------------------------------------------------------------
sub hunter
{
    write_log( "Received the INT signal.  Closing down" );

    foreach my $pid (keys %children) {
	kill 'INT', $pid;
    }

    exit;
}

# -----------------------------------------------------------------------
#
# write_log
#
# Write a message to the log file, if the log file is specified by the
# log option in the [common] section of the configuration file.
#
# -----------------------------------------------------------------------
sub write_log
{
    my ( $message ) = @_; # Message to write to log

    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.  Uses the
# global $config variable to get the location of the configuration
# file.
#
# Returns 1 if successful, or 0 if error
#
# -----------------------------------------------------------------------
sub read_configuration
{
    # The configuration file consists of two section types: common and
    # mirage.  common contains configuration options for the entire
    # program and each mirage contains configuration for a single port

    if ( open CFG, "<$config" ) {
        my $section = '';
        my $error = 0;
        my $line = 0;
        my $mirage;
        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 =~ /^\[mirage-(.+)\]$/ ) {
                $section = 'mirage';
                $mirage = $1;
                if ( defined( $mirages{$mirage} ) ) {
                    print STDERR "Only one [mirage-$mirage] section allowed; ";
                    print STDERR "mirage 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 "[mirage-X]\n";
                $error = 1;
                last;
            }

            if ( $val =~ /\s*([^\s]+)\s*=\s*(.+)/ ) {
                my ( $parameter, $value ) = ( $1, $2 );
                if ( $section eq 'common' ) {
                    if ( $parameter eq 'log' ) {
                        $log = $value;
                        next;
                    } else {
                        print STDERR "The valid options in the common section ";
                        print STDERR "are 'log = X'; don't ";
                        print STDERR "understand '$val'\n";
                        $error = 1;
                        last;
                    }
                } else {
                    if ( $parameter eq 'secret' ) {
                        $mirages{$mirage}{secret} = $value;
                        next;
                    } elsif ( $parameter eq 'port' ) {
                        $mirages{$mirage}{port} = $value;
                        next;
		    } elsif ( $parameter eq 'range' ) {
			if ( ( $value =~ /^(\d+)-(\d+)$/ ) &&
			  ( $2 > $1 ) ) {
			  $mirages{$mirage}{low} = $1;
			  $mirages{$mirage}{high} = $2;
		        } else {
			  print STDERR "range must be in the form X-Y where ";
			  print STDERR "X is less than Y and both are numbers.";
			  print STDERR "The range is inclusive.\n";
			  $error = 1;
		        }
                    } else {
                        print STDERR "In a mirage section the valid options ";
                        print STDERR "are 'secret', 'port' and 'range'; 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'.  Can't 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,
                      'help'       => \$help ) ) {
        $help = 1;
    }

    # Handle getting help

    if ( $help ) {
        print "shimmerd v$version - daemon that implements port shimmering\n";
        print "\nOptions:\n";
        print "\n--config    Set the config file to load (default: $config)";
	print "\n--help      This help information\n";

        return 0;
    }

    return 1;
}

# -----------------------------------------------------------------------
#
# validate_setup
#
# Checks the configuration of shimmer for errors, returns 1 if
# everything is ok
#
# -----------------------------------------------------------------------
sub validate_setup
{
    # Check that each mirage has a secret, a port and a range

    my %used;

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

            return 0;
        }

        if ( !defined( $mirages{$mirage}{port} ) ) {
            print STDERR "mirage '$mirage' does not have a port defined. ";
            print STDERR "Set the port in the appropriate [mirage-$mirage] ";
            print STDERR "section of the config file '$config'\n";

            return 0;
        }

        if ( !defined( $mirages{$mirage}{low} ) ) {
            print STDERR "mirage '$mirage' does not have a range defined. ";
            print STDERR "Set the range in the appropriate [mirage-$mirage] ";
            print STDERR "section of the config file '$config'\n";

            return 0;
        } else {

	    # Make sure that mirages do not have overlapping port ranges
	    
	    foreach my $i ($mirages{$mirage}{low}...$mirages{$mirage}{high}) {
		if ( defined( $used{$i} ) ) {
		    print STDERR "The port range for '$mirage' overlaps with";
		    print STDERR " the port range for '$used{$i}'. Port ranges";
		    print STDERR " must not overlap.\n";

		    return 0;
		}

		$used{$i} = $mirage;
	    }
	}
    }


    return 1;
}

# -----------------------------------------------------------------------
#
# run_shimmer
#
# Run the shimmer process shimmering ports
#
# -----------------------------------------------------------------------
sub run_shimmer
{
    write_log( "shimmer v$version started" );

    # This holds the timestamp (unix style) of the last 'minute'
    # generated

    my $last_minute = get_current_minute();

    # This hash contains all the ports currently being managed.  Each
    # entry has the following (they key is the port number):
    #
    # minutes    A list of minutes for which this port is in use
    # forward    If set then this is a good port, if not then it's a trap
    # handle     IO::Socket handling the port
    # select     IO::Select for the handle

    my %ports;

    open_ports( \%ports, $last_minute - 1 );
    open_ports( \%ports, $last_minute     );
    open_ports( \%ports, $last_minute + 1 );

    # This is the main loop that processes connection requests on the
    # trap port and check to see if a minute has passed to handle the
    # next group of ports

    while ( 1 ) {
        process_connections( \%ports );

	my $current_minute = get_current_minute();

	if ( $current_minute > $last_minute ) {
	    close_ports( \%ports, $last_minute - 1 );
	    open_ports( \%ports, $current_minute + 1 );
	    $last_minute = $current_minute;
	}

	# Unblacklist any IP address that hasn't attempted to
	# connection for 15 minutes

	my $blacklist_timeout = 15 * 60;

	foreach my $ip (keys %blacklist) {
	    if ( ( $blacklist{$ip} + $blacklist_timeout ) < time ) {
		write_log( "Unblacklisting IP $ip" );
		
		delete $blacklist{$ip};
	    }
	}

	select( undef, undef, undef, 0.01 );
    }

    # This function never terminates, see handling of INT by hunter
    # above
}

# -----------------------------------------------------------------------
#
# process_connections
#
# This function runs through all the open ports and sees if there are
# connections pending.  If there are, they are accepted and either
# handed off to forward_port to handle a safe port that needs
# forwarding to a genuine service, or a call is made to blacklist_ip
# to blacklist the IP address and the connection is closed.
#
# -----------------------------------------------------------------------
sub process_connections
{
    my ( $ports ) = @_; # Reference to the %ports hash

    foreach my $port (keys %$ports) {
	if ( defined( $$ports{$port}{select} ) ) {
	    if ( $$ports{$port}{select}->can_read(0) ) {
		my $conn = $$ports{$port}{handle}->accept(0);
		
		if ( $conn ) {
		    my $sockaddr = $conn->peername;
		    my ($port_unused, $iaddr) = sockaddr_in($sockaddr);
		    my $ip = inet_ntoa( $iaddr );
		    
		    write_log( "Got connection on port $port from $ip" );
		    
		    if ( !defined( $blacklist{$ip} ) ) {
			if ( defined( $$ports{$port}{forward} ) ) {
			    forward_port( $conn, $$ports{$port}{forward} );
			} else {
			    blacklist_ip($ip);
			}
		    } else {
			write_log( "Ignoring connection from blacklisted IP $ip" );
			
			$blacklist{$ip} = time;
		    }
		    
		    $conn->close;
		}
	    }
	}
    }
}

# -----------------------------------------------------------------------
#
# forward_port
#
# Forwards traffic on a port to another port on the local machine.
# This function first establishes a connection to the local service
# and then enters a loop passing traffic unchanged back and forth
# between the remote side and the local service.  This function
# forks() a sub-process to handle the entire forwarding process and
# that process will terminate when either side of the communication
# drops the connection.
#
# -----------------------------------------------------------------------
sub forward_port
{
    my ( $handle,      # Reference to the IO::Socket to forward
         $port ) = @_; # The local port to connect to

    write_log( "Port forward requested to $port" );

    my $pid = fork();

    if ( $pid == 0 ) {

	# Reset signal INT handling to default behaviour so that the
	# parent hunter doesn't get called by a child process.

        $SIG{INT} = 'DEFAULT';

	# TODO: Close duplicated handles?

	my $to = IO::Socket::INET->new( PeerPort => $port,
	                                PeerAddr => '127.0.0.1',
	                                Proto    => 'tcp' );
	my $to_selector = IO::Select->new( $to );
	my $handle_selector = IO::Select->new( $handle );

	$handle->blocking( 0 );
	$to->blocking( 0 );

	while ( $handle->connected && $to->connected ) {
	    if ( $to_selector->can_read(0) ) {
		if ( !forward( $to, $handle ) ) {
		    last;
		}
	    }

	    if ( $handle_selector->can_read(0) ) {
		if ( !forward( $handle, $to ) ) {
		    last;
		}
	    }
	}

	$handle->shutdown(2);
	$handle->close;
	$to->shutdown(2);
	$to->close;

	exit;
    }

    if ( !defined( $pid ) ) {
	write_log( "Failed to fork, unable to forward port" );
    } else {
	write_log( "Child $pid running for port $port" );
	$children{$pid} = 1;
    }
}

# -----------------------------------------------------------------------
#
# forward
#
# Read data from one handle and write it on another until there's
# nothing left to read.
#
# Returns 0 if there's a fatal error or if the connection is dropped, 
# otherwise returns 1.
#
# -----------------------------------------------------------------------
sub forward
{
    my ( $from,      # Read data from this handle
	 $to ) = @_; # And write it to this one

    my $max = 1024;
    my $data;
    my $bytes;

    while ( $bytes = sysread( $from, $data, $max ) ) {
	while ( $bytes > 0 ) {
	    my $written = syswrite( $to, $data, $bytes,
				    length($data) - $bytes );
	    if ( !defined( $written ) ) {
		write_log( "Write error forwarding port" );
		last;
	    }
	    
	    $bytes -= $written;
	}
    }

    # If we reach here and $bytes is defined and zero then the connection
    # is dead.

    if ( defined( $bytes ) && ( $bytes == 0 ) ) {
	return 0;
    }

    # Otherwise we could have an error, if it's EAGAIN then connection
    # is still alive.

    if ( $!{EAGAIN} ) {
	return 1;
    }
    
    return 0;
}

# -----------------------------------------------------------------------
#
# get_current_minute
#
# Returns the number of minutes since the start of the Unix epoch as
# an integer
#
# -----------------------------------------------------------------------
sub get_current_minute
{
    return int( time / 60 );
}

# -----------------------------------------------------------------------
#
# blacklist_ip
#
# Add an IP address to the local blacklist so that any connection
# attempts from that IP are automatically rejected.
#
# -----------------------------------------------------------------------
sub blacklist_ip
{
    my ( $ip ) = @_; # The IP address to blacklist (dotted string format)

    write_log( "Blacklisting IP $ip" );

    $blacklist{$ip} = time;
}

# -----------------------------------------------------------------------
#
# close_ports
#
# Called when a time slice has expired to close all ports associated
# with a particular minute.  This removes the ports from the %ports
# hash and if a port is not associated with any other minute it is
# acutally closed and the hash entry removd.
#
# -----------------------------------------------------------------------
sub close_ports
{
    my ( $ports,         # Reference to the %ports hash
	 $minute ) = @_; # The identifier of the minute that is expiring

    my @closed;
    my @kept;

    foreach my $port (keys %$ports) {
	my $was = ( $$ports{$port}{minutes} =~ s/\[$minute\]// );

	if ( $was ) {
	    if ( $$ports{$port}{minutes} !~ /[^ ]/ ) {
		push @closed, ($port);
		$$ports{$port}{handle}->shutdown(2);
		$$ports{$port}{handle}->close;
		delete $$ports{$port};
	    } else {
		push @kept, ($port);
	    }
	}
    }

    write_log( "Minute $minute, closed ports " . join( ', ', @closed ) );
    if ( $#kept > -1 ) {
	write_log( "Minute $minute, kept ports " . join( ', ', @kept ) );
    }
}

# -----------------------------------------------------------------------
#
# open_ports
#
# This function translates a given minute into a collection of ports
# to be used for the mirage and opens the ports necessary creating the
# appropriate binding between the safe port and the unsafe ports for
# blacklisting.  It updates the %ports hash with the new mappings.
#
# -----------------------------------------------------------------------
sub open_ports
{
    my ( $ports,         # Reference to the %ports hash
	 $minute ) = @_; # The identifier of the current minute

    # This is the hash that will be returned by the function, see the
    # description of @names above for details.

    my %data;

    # Loop through the mirages, calculate the ports necessary and call
    # map_port to actually map the port in the firewall

    foreach my $mirage (keys %mirages) {

        # First work out the unpredictable data that will be used to
        # to create a set of keys.  This is done by hashing the mirage
        # name plus secret plus a fixed string plus the current
        # minute.  With this we get a 256 bit key that can be fed into
        # Rijndael.  Rijndael is run in counter mode to generate the
        # ports.  The first port generated (which corresponds to
        # Rijndael encrypting 0) is used to map the 'real' port, all
        # the rest are mapped to the trap.

        my $key = sha256( "$mirage - " . $mirages{$mirage}{secret} .
			  " - $minute" );
	my $cipher = Crypt::Rijndael->new( $key,
					   Crypt::Rijndael::MODE_ECB() );

	# We will generated a number between 0 and $range and then add
	# it to $low to get a port in the desired mirage range

	my $low = $mirages{$mirage}{low};
	my $range = $mirages{$mirage}{high} - $low;

	my @new_ports;

	my $ctr = 0;
	while ( $#new_ports < 15 ) {
	    my $plain = pack( "V4", ( 0, 0, 0, $ctr ) );
	    my $secret = $cipher->encrypt( $plain );

	    $secret = unpack( "V", $secret );
	    $secret %= $range;
	    my $port = $secret + $low;

	    if ( !grep( /^$port$/, @new_ports ) ) {
	        push @new_ports, ($port);
	    }

	    ++$ctr;
	}
	
	# The first port is the 'safe port' (the port that will
	# actually forward to the service that is being shimmered).
	# If this port were previously in use as an unsafe port
	# (causing blacklisting) then setting the {forward} key here
	# to the port number will turn it into a safe port.  This
	# cannot be overwritten later because the loop below checks to
	# see if a port is lisenting and will only create a new unsafe
	# port on an unused port number.

	write_log( "Minute $minute has ports " . join( ', ', @new_ports ) );

	my $safe_port = shift @new_ports;
	$$ports{$safe_port}{forward} = $mirages{$mirage}{port};
	$$ports{$safe_port}{minutes} .= "[$minute]";

	if ( !defined( $$ports{$safe_port}{handle} ) ) {
  	    ( $$ports{$safe_port}{handle},
	      $$ports{$safe_port}{select} ) = start_listening( $safe_port );
	}

	foreach my $port (@new_ports) {
	    if ( ( !defined( $$ports{$port}{handle} ) ||
		   ( defined( $$ports{$port}{forward} ) ) ) ) {
	        my ( $handle, $select ) = start_listening( $port );
		if ( defined( $handle ) ) {
		    $$ports{$port}{forward} = undef;
		    $$ports{$port}{handle} = $handle;
		    $$ports{$port}{select} = $select;
		    $$ports{$port}{minutes} .= "[$minute]";
		}
	    }
	}
    }
}

# -----------------------------------------------------------------------
#
# start_listening
#
# A wrapper function around IO::Socket that starts listening on a
# specific TCP port number and create an IO::Select so that we can
# check for waiting connections efficiently.
#
# Returns a pair ( IO::Socket, IO::Select ) containing the opened port
# and selector.  If there's a failure this returned ( undef, undef )
#
# -----------------------------------------------------------------------
sub start_listening
{
    my ( $port ) = @_;

    my $handle = IO::Socket::INET->new( LocalPort => $port,
					Listen    => SOMAXCONN,
					Proto     => 'tcp' );

    my $select = undef;

    if ( !defined( $handle ) ) {
        write_log( "Failed to get handle for port $port" );
    } else {
        $select = IO::Select->new( $handle );
    }

    return ( $handle, $select );
}

# MAIN

if ( parse_command_line() ) {
    if ( read_configuration() ) {
        if ( validate_setup() ) {
            run_shimmer();
        }
    }
}

# A normal exit only comes through an INT signal since run_shimmer
# never returns.  Getting here means something (command-line,
# coniguration file or setup was incorrect).

exit 1;
