#!/usr/bin/perl -w
$|++;

# This script requires Crypt::CBC and Crypt::Blowfish, to install:
#
# 1) as root: perl -MCPAN -e shell
# 2) at the cpan prompt type 'install Crypt::CBC' and 'install Crypt::Blowfish'
#
# Sat Aug  8 20:53:36 EDT 2009
# Michael Williams, maverick@maverick.org
################################################################################
# TODO:
#   
#   - Bind to a specific address
#   - Buffering / message queuing if file is locked
#   - Add option to -S <start|stop>, capture kill signal
#   - Config files
#   - Profiles (different ports, different files)
#   - Version information
################################################################################
# COMPLETED:
#   2009.Aug.07 - Removed SSH and local options, cleaned up code
#   2009.Aug.07 - Added encryption with Blowfish && CBC, removed xor encryption
#   2009.Aug.03 - Added -f parm to specify log file
#               - Display help on unknown options
#               - Added -r switch for remote server address
#   2009.Aug.02 - Code clean up
#               - Light weight encryption - Note, this is more obfuscation than
#                 encryption, if you need strong encryption use the SSH option!
#   2009.Jul.21 - Added length checking to client / server udp messages
#   2009.Jul.21 - Added md5 checksums for messages
#   2009.Jul.08 - Syslog error messages, remove die, replace with error();
#   2009.Jul.06 - File locking
################################################################################

use strict;
use IO::Socket;
use Getopt::Std;
use Text::Wrap;
use Digest::MD5 qw (md5_hex);
use Sys::Hostname;
use Sys::Syslog;
use Crypt::CBC;

Sys::Syslog'setlogsock('unix');                          #'
openlog('dwl', 'pid,ndelay', 'user');

my %options = ();
getopts('aAcdf:hS:r:sp:', \%options) or usage();  

use constant CLIENT   => 1;
use constant SERVER   => 2;
use constant SERVER_F => 3;

# Default transport method
my $transport_method = CLIENT;

my $client_hostname = hostname;
my $divider = chr(176);
my @text;

################################################################################
# General options

my $debug      = 0;              # Debug mode, 1 = on, 0 = off
my $editor_bin = '/usr/bin/vim'; # our choice of editor, comment this line out
                                 # to use the internal editor
################################################################################
# Client / server specific options

my $server_address = '10.1.1.5'; # IP or FQDN

my $gmaxlen = 2048;    # Maximum length of message 
my $port    = 5151;    # UDP port to send / receive
my $timeout = 5;       # Transmission timeout (seconds)

# Encryption key, up to 56 bytes
my $key = 'ABCDEFGH01234567';

# Location of log file, used for server
my $log_file = $ENV{'HOME'} . "/dwl.log";

# Location of pid file, used for server
my $pid_file = '/tmp/dwl.pid'; 

# Enforce access control lists? 1 = Yes, 0 = No
my $use_acls = 1;      

# List of allowed clients
my %ACL = ( '127.0.1.1'    => 1,
            '10.1.1.5'     => 1
          );

################################################################################
# Parse the command line options

usage()                 if (defined($options{h}));
$debug    = 1           if (defined($options{d}));
$log_file = $options{f} if (defined($options{f}));
$port     = $options{p} if (defined($options{p}));

error("Key can not be longer than 56 characters") if (length($key) > 56 );
my $packed_key     = pack("H16", $key); 

my $cipher = Crypt::CBC->new( -key    => $packed_key,
                              -cipher => 'Blowfish'
                            );

error("The -a and -A are mutually exclusive, you can't use both.")
  if (defined($options{a}) && defined($options{A}));

$use_acls = 1 if (defined($options{a}));
$use_acls = 0 if (defined($options{A}));

if (defined($options{r})) {
  $server_address = $options{r} if (defined($options{r}));
  print "Server: ${server_address}:${port}\n" if ($debug);	
}

# Start or stop a forking server
if (defined($options{S})) {
  my $server_mode = $options{S};

  error("Unkown mode to -S switch: $server_mode")
    unless ($server_mode =~ /(start|stop)/);

  stop_server()  if ($server_mode eq 'stop');
  start_server() if ($server_mode eq 'start');
}

if (defined($options{s})) {
  print "Server Mode: Non-Forking\n" . 
        "Awaiting UDP messages on port $port\n" if ($debug);
  server();
  exit;
}

# If there are any arguments left after parsing the command line
# treat it as text, otherwise call the editor

if (@ARGV) {
  @text = @ARGV;
} else {
  @text = editor();
}

send_udp_message(join(' ',@text)) if ($transport_method == CLIENT );

exit 0;

sub server
{
  my ($sock, $msg, $remote_addr, $remote_name);
  my ($date_stamp, $digest, $check_digest);
  my $maxlen = $gmaxlen + 32 + 1; # 32 bytes for md5 + 1 for seperator
  my @text;

  sl("Starting server on port $port...");

  print "ACL's: " if ($debug);
  ($use_acls) ? print "On\n" : print "Off\n" if ($debug);

  print "Log file: $log_file\n" if ($debug);

  $sock = IO::Socket::INET->new(LocalPort => $port, Proto => 'udp')
      or error("socket: $@");

  while ($sock->recv($msg, $maxlen)) {
      my ($port, $ipaddr) = sockaddr_in($sock->peername);

      $remote_name = gethostbyaddr($ipaddr, AF_INET);
      $remote_addr = inet_ntoa($ipaddr);

      # Check ACL for both DNS name and IP
      if ($use_acls) {
        unless (exists($ACL{$remote_name}) || exists($ACL{$remote_addr})) {
          print "Client not in ACL list: $remote_name ($remote_addr)\n" 
            if ($debug);
          sl("Client not in ACL list: $remote_name ($remote_addr)");
          $sock->send("IP address $remote_addr is not authorized.");
          next;
        }
      }

      $msg = $cipher->decrypt($msg);

      ($msg,$digest) = split($divider,$msg);

      unless (defined($msg) && defined($digest)) {
        print "Garbled message received from $remote_addr.\n" if ($debug);
        sl("Garbled message received from $remote_addr.");
        $sock->send("Garbled message received.");
        next;
      }

      $check_digest = md5_hex($msg);

      if ($check_digest ne $digest) {
        print "Warning: Mismatched md5sum for message:\n  \"$msg\" " .
              " from $remote_addr\n" .
              "  Sent: $digest vs. Local: $check_digest\n";
       
        $sock->send("Corrupt message received. Not logged.");

        next;
      } 

      @text = split(' ',$msg);
      write_log($remote_name,@text);
      $sock->send("Ok.");
      print "Received \"$msg\" with md5 of $digest from $remote_addr\n" 
        if ($debug);
  } 
  error("recv: $!");
}

sub start_server
{
  print "Server Mode: Forking\n" if ($debug);

  if ( -f $pid_file ) {
    print "\nAnother server appears to be running. If this is not the case\n",
          "then delete $pid_file and restart the server.\n";

    error("start_server: PID file $pid_file already exists.");
  }

  my $pid = fork();

  if ($pid == 0) {
    server();
  } else {
    print "PID: $pid\n" if ($debug);

    open(FP,">$pid_file") || error("Could not create $pid_file");
    print FP "$pid\n";
    close(FP);
    exit;
  }
}

sub send_udp_message {
  my $msg = shift;
  my $digest = md5_hex($msg);
  my ($sock, $ipaddr, $hishost, $encrypted);
  my $maxlen = $gmaxlen + 32 + 1; # 32 bytes for md5 + 1 for seperator

  
  if (length($msg) > $maxlen) {
    print "Length of message (" . length($msg) . ") exceeds the defined \$maxlen of $gmaxlen\n",
          "Increase the the \$maxlen variable and restart the server.\n";
    exit;
  }

  print "Sending: \"$msg\" with md5 of \"$digest\"\n" if ($debug);

  # Build our string of the message, seperator and md5
  $msg = $msg . $divider . $digest;

  $encrypted = $cipher->encrypt($msg);

  $sock = IO::Socket::INET->new(Proto     => 'udp',
                                PeerPort  => $port,
                                PeerAddr  => $server_address)
      or error("Creating socket: $!");

  $sock->send($encrypted) or error("send_udp_message: send: $!");

  eval {
      local $SIG{ALRM} = sub { error("Timed out while sending message.") };
      alarm $timeout;
      $sock->recv($msg, $maxlen)  or error("send_udp_message: $!");
      alarm 0;
      1;  # return value from eval on normalcy
  } or error("No response from from $server_address after $timeout seconds.");

  ($port, $ipaddr) = sockaddr_in($sock->peername);
  $hishost = gethostbyaddr($ipaddr, AF_INET);
  print "$msg\n";
}

sub write_log {
  my ($client_hostname,@text) = @_;

  my $entry = wrap("","    ",@text);

  my $datestamp = get_datestamp();

  $entry = "$datestamp @ $client_hostname\n  - $entry\n";

  open  FP, ">>$log_file" || error("Couldn't open $log_file for writing.");

  flock FP, 2; # exclusive file lock

  seek(FP,0,2);

  print FP "$entry\n";

  flock FP, 8; # unlock the file
  close FP;

  return "Ok.";
}

sub get_datestamp
{
  my @mabbr    = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
  my @wabbr    = qw( Sun Mon Tue Wed Thu Fri Sat );
  my ($wday,$mon,$mday,$hour,$min) = (localtime(time))[6,4,3,2,1];
  my $timestamp = sprintf("%02d:%02d",$hour,$min);
  my $datestamp = "$wabbr[$wday], $mabbr[$mon] $mday @ $timestamp";

  return ($datestamp);
}

sub editor
{
  my @text;

  unless ((defined($editor_bin)) && (-x $editor_bin)) {
    print "\nCTRL-D when finished\n" . '-' x 79 . "\n";

    while (<STDIN>) {
      push(@text,$_);
    }
    print '-' x 79 . "\n";
  } else {
    my $tmpfile = '/tmp/dwl.' . int(rand(1000000));
    error("temp file already exists: $tmpfile, quitting.\n") if (-f $tmpfile);
    system("$editor_bin $tmpfile") == 0 or error("Error executing $editor_bin");

    exit 0 if ( ! -f $tmpfile);

    open(FP,$tmpfile);
    @text = <FP>;
    close(FP);
    unlink($tmpfile)
     or error("Can't remove temp file \"$tmpfile\", please remove it manually.");
  }

  return (@text);
}

sub sl
{
  my $msg = shift;

  syslog('info',$msg);
}

sub error
{
  my $msg = shift;

  sl("Error: $msg");
  print "\nError: $msg\n";
  exit 1;
}

sub stop_server
{
  my $pid;

  unless (-f $pid_file) {
    print "\nA server doesn't appear to be running.\n";
    exit;
  }

  open(FP,"<$pid_file");
  $pid = <FP>;
  close(FP);

  print "Killing PID: $pid\n" if ($debug);

  exit;
}

sub usage
{
print <<EOF;

$0 [options] [string]

  -c   :: Client mode
  -s   :: Server mode (foreground)
  -S <start|stop>  
       :: Server mode (background)

  -a   :: Enable client ACL's (server only)
  -A   :: Disable client ACL's (server only)

  -r   :: Remote server address (client mode)

  -p <port> :: Listen / Send on UDP <port> (client/server mode)

  -f   :: /path/to/logfile
  -d   :: Debug
  -h   :: Help (this text)

EOF

  exit;
}