#!/usr/bin/perl -w

#
# bleh bleh OO perl ownz j00
#
use strict;
use Crypt::Blowfish;
use IO::Socket;
use Fcntl qw(:flock);
use vars qw($sock $cipher $acpt_sock $key $pid $in);

#
# takes a string of any size and pads string with SOH char
# if the string does not split into $blocksize byte segments evenly
#
sub pad {
  my($string) = shift;
  my($blocksize) = shift;  
  my($strlen) = length($string);
  
  
  return($string) if ($strlen == $blocksize);
  return($string.chr(1)x($blocksize - $strlen)) if ($strlen < $blocksize);
  if ($strlen > $blocksize) {
    while($strlen = $strlen - $blocksize) {
      last if ($strlen < $blocksize);
    }
    return($string.chr(1)x($blocksize - $strlen));
  }

  return($string);
}

#
# takes a Crypt::Blowfish handle and a string of any size
# then uses pads string useing pad() function then chunks
# off 8 byte segments of string and encrypt's those and 
# assembles encrypted string in a scalar to be returned 
#
sub encrypt {
        my($handle) = shift || return(undef());
        my($string) = pad(shift,8) || return(undef());
        my($ret,$offset);
        
        $offset = 0;
        while(defined($_ = substr($string,$offset,8))) {
                $ret .= $handle->encrypt($_) unless(!$_);
                $offset = int($offset) + 8;
                last if ($offset >= length($string));
        }
        return($ret);
}

# 
# takes encrypted string (in binary of course).
# then decryptes string in 8 byte segments
# and assembles in scalar to be returned
#
sub decrypt {
        my($handle) = shift || return(undef());
        my($string) = shift || return(undef());
        my($ret,$offset);

        $offset = 0;
        while(defined($_ = substr($string,$offset,8))) {
                $ret .= $handle->decrypt($_) unless(!$_);
                $offset = int($offset) + 8;
                last if ($offset >= length($string));
        }
        return($ret);
}
        
#
# main code starts here (i.e. not sub routines)
#

#
# spout usage is less than or more than one argument
#
die "Usage: $0 <keyfile>\n" unless(@ARGV==1);

#
# read in key file for use with Crypt::Blowfish
# 
local(*KEY);
open(KEY,$ARGV[0]) || die "$!: \"$ARGV[0]\"\n";
flock(KEY,LOCK_EX);
$key = <KEY>;
close(KEY);

#
# build my Crypt::Blowfish handle useing $key
#
$cipher = new Crypt::Blowfish $key;

#
# build my IO::Socket handle for being a tcp server
#
$sock = IO::Socket::INET->new(
        LocalPort =>9200, # set port to listen on to 9200
        Listen    =>5, # Accept only 5 connections at once (pointless)
        Proto     =>'tcp', # use tcp proto
        Reuse     =>1 # my kernel happy by free ports immediatly
);

#
# loop to handle accepting connections as well as server 
# type mombo jumpo such as server codes, parsing, decryption
#
while($acpt_sock = $sock->accept()) {
        print "Connection from ",$acpt_sock->peerhost(),":",$acpt_sock->peerport(),"\n" unless(!$acpt_sock);
        unless($pid = fork() && $acpt_sock) {
                print $acpt_sock "-OK- Crypted Server\n\r" unless(!$acpt_sock);
                while(<$acpt_sock>) {
                        s/(\r|\n)//g;
                        print $acpt_sock encrypt($cipher,decrypt($cipher,$_)),"\r\n";
                }
                print "Connection closed by ",$acpt_sock->peerhost(),":",$acpt_sock->peerport(),"\n" unless(!$acpt_sock);
                close($acpt_sock);
                exit(0);
        }
}