#!/usr/bin/perl -w
use strict;

# BlowJob 0.9.0, a crypto script - ported from xchat
# was based on rodney mulraney's crypt
# changed crypting method to Blowfish+Base64+randomness+Z-compression
# needs :
#         Crypt::CBC,
#         Crypt::Blowfish,
#         MIME::Base64,
#         Compress::Zlib
#
# crypted format is :
# HEX(Base64((paranoia-factor)*(blowfish(RANDOM+Zcomp(string))+RANDOM)))
#
# 10-03-2004 Removed seecrypt, fixed two minor bugs
# 09-03-2004 Supporting multiline messages now.
# 08-03-2004 Lots of bugfixes on the irssi version by Thomas Reifferscheid
# 08-03-2004 CONF FILE FORMAT CHANGED
#
#            from server:channel:key:paranoia
#            to   server:channel:paranoia:key
#
#            /perm /bconf /setkey /showkey working now
#            keys may contain colons ":" now.
#
#
# 06-12-2001 Added default umask for blowjob.keys
# 05-12-2001 Added paranoia support for each key
# 05-12-2001 Added conf file support
# 05-12-2001 Added delkey and now can handle multi-server/channel keys
# 05-12-2001 permanent crypting to a channel added
# 05-12-2001 Can now handle multi-channel keys
# just /setkey <key> on the channel you are to associate a channel with a key
#
# --- conf file format ---
#
# # the generic key ( when /setkey has not been used )
# key:            generic key value
# # header that marks a crypted sentance
# header:         {header}
# # enable wildcards for multiserver entries ( useful for OPN for example )
# wildcardserver: yes
#
# --- end of conf file ---
#
# iMil <imil@gcu-squad.org>
# skid <skid@gcu-squad.org>
# Foxmask <odemah@gcu-squad.org>
# Thomas Reifferscheid <blowjob@reifferscheid.org>

use Crypt::CBC;
use Crypt::Blowfish;
use MIME::Base64;
use Compress::Zlib;

use Irssi::Irc;
use Irssi;
use vars qw($VERSION %IRSSI $cipher);

$VERSION = "10.9.0";
%IRSSI = (
    authors => 'iMil,Skid,Foxmask,reiffert',
    contact => 'imil@gcu-squad.org,blowjob@reifferscheid.org,#blowtest@freenode',
    name => 'blowjob',
    description => 'Crypt IRC communication with blowfish encryption. Supports public #channels, !channels, +channel, querys and dcc chat. Roadmap for Version 1.0.0 is to get some feedback and cleanup. Join #blowtest on freenode (irc.debian.org) to get latest stuff available. Note to users upgrading from versions prior to 0.8.5: The blowjob.keys format has changed.',
    license => 'GNU GPL',
    url => 'http://ftp.gcu-squad.org/misc/',
);

# You can modify these default colors to suit your preferences:
# status messages
my $status_col=        "\00314"; # default: 14 gray
# content of variables within status messages
my $variables_col=     "\00301"; # default: 15 light gray
# color of own nick when sending a blowed message
my $own_nick_col=      "\00301"; # default: 01 black
# color for surround brackets and blow header in a sent blowed message
my $default_nick_col=  "\00301"; # default: 01 black
# error messages
my $err_col=           "\00305"; # default: 05 red
# message text color for encrypted messages
#my $msg_col=           "\00301"; # default: 11 light cyan

my $msg_col=           "\00311"; # default: 11 light cyan

# appendices for nicks using blow
my $encrypt_appendix=  "|{enc}";
my $decrypt_appendix=  "|{dec}";

############# IRSSI README AREA #################################
#To install this script just do
#/script load ~/blowjob-irssi.pl
#  and
#/blowhelp
#  to read all the complete feature of the script :)
#To uninstall it do
#/script unload blowjob-irssi
################################################################


my $key = 'very poor key' ; # the default key
my $header = "{blow}";
# Crypt loops, 1 should be enough for everyone imho ;)
# please note with a value of 4, a single 4-letter word can generate
# a 4 line crypted sentance
my $paranoia = 1;
# add a server mask by default ?
my $enableWildcard="yes";

my $alnum = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";

my $gkey;
sub loadconf
{
  my $fconf =Irssi::get_irssi_dir()."/blowjob.conf";
  my @conf;
  open (CONF, "<$fconf");

  if (!( -f CONF)) {
    Irssi::print($err_col."> $fconf not found, setting to defaults\n");
    Irssi::print($err_col."> creating $fconf with default values\n\n");
    close(CONF);
    open(CONF,">$fconf");
    print CONF "key:			$key\n";
    print CONF "header:			$header\n";
    print CONF "wildcardserver:		$enableWildcard\n";
    print CONF "decrypt_appendix:	$decrypt_appendix\n";
    print CONF "encrypt_appendix:	$encrypt_appendix\n";
    print CONF "status_col:		$status_col\n";
    print CONF "variables_col:		$variables_col\n";
    print CONF "own_nick_col:		$own_nick_col\n";
    print CONF "default_nick_col:	$default_nick_col\n";
    print CONF "err_col:		$err_col\n";
    print CONF "msg_col:		$msg_col\n";
    close(CONF);
    return 1;
  }

  @conf=<CONF>;
  close(CONF);

  my $current;
  foreach(@conf) {
    $current = $_;
    $current =~ s/\n//g;
    if ($current =~ m/key/) {
      $current =~ s/.*\:[\ \t]*//;
      $key = $current;
      $gkey = $key;
    }
    if ($current =~ m/header/) {
      $current =~ s/.*\:[\s\t]*\{(.*)\}.*/{$1}/;
      $header = $current;
    }
    if ($current =~ m/wildcardserver/) {
      $current =~ s/.*\:[\ \t]*//;
      $enableWildcard = $current;
    }
    if ($current =~ m/encrypt_appendix/) {
      $current =~ s/.*\:[\ \t]*//;
      $encrypt_appendix = $current;
    }
    if ($current =~ m/decrypt_appendix/) {
      $current =~ s/.*\:[\ \t]*//;
      $decrypt_appendix = $current;
    }
    if ($current =~ m/status_col/) {
      $current =~ s/.*\:[\ \t]*//;
      $status_col = $current;
    }
    if ($current =~ m/variables_col/) {
      $current =~ s/.*\:[\ \t]*//;
      $variables_col = $current;
    }
    if ($current =~ m/default_nick_col/) {
      $current =~ s/.*\:[\ \t]*//;
      $default_nick_col = $current;
    }
    if ($current =~ m/own_nick_col/) {
      $current =~ s/.*\:[\ \t]*//;
      $own_nick_col = $current;
    }
    if ($current =~ m/msg_col/) {
      $current =~ s/.*\:[\ \t]*//;
      $msg_col = $current;
    }
  }
  Irssi::print($status_col."- configuration file loaded\n");
  return 1;
}
loadconf;

my $kfile ="$ENV{HOME}/.irssi/blowjob.keys";
my @keys;
$gkey=$key;
my $gparanoia=$paranoia;

sub loadkeys
{
  if ( -e "$kfile" ) {
    open (KEYF, "<$kfile");
    @keys = <KEYF>;
    close (KEYF);
  }
  Irssi::print($status_col."- keys reloaded (Total:$variables_col ".
	       scalar @keys."$status_col)\n");
  return 1;
}
loadkeys;

sub getkey
{
  my ($curserv, $curchan) = @_;

  my $gotkey=0;
  my $serv;
  my $chan;
  my $fkey;

  foreach(@keys) {
    chomp;                                            # keys can contain ":" now. Note:
    my ($serv,$chan,$fparanoia,$fkey)=split /:/,$_,4; # place of paranoia has changed!
    if ( $curserv =~ /$serv/ and $curchan eq $chan ) {
      $key= $fkey;
      $paranoia=$fparanoia;
      $gotkey=1;
    }
  }
  if (!$gotkey) {
    $key=$gkey;
    $paranoia=$gparanoia;
  }
  $cipher=new Crypt::CBC({ key => $key,
                           cipher => 'Blowfish',
                           header => 'randomiv'});
}

sub setkey
{
  my (undef,$server, $channel) = @_;
  if (! $channel) { return 1; }
  my $curchan = $channel->{name};
  my $curserv = $server->{address};
  # my $key = $data;

  my $fparanoia;

  my $newchan=1;
  umask(0077);
  unless ($_[0] =~ /( +\d$)/) {
     $_[0].= " $gparanoia";
  }
  ($key, $fparanoia) = ($_[0] =~ /(.*) +(\d)/);

  if($enableWildcard =~ /[Yy][Ee][Ss]/) {
      $curserv =~ s/(.*?)\./(.*?)\./;
    Irssi::print($status_col."IRC server wildcards enabled\n");
  }

  # Note, place of paranoia has changed!
  my $line="$curserv:$curchan:$fparanoia:$key";

  open (KEYF, ">$kfile");
  foreach(@keys) {
    s/\n//g;
    if (/^$curserv\:$curchan\:/) {
      print KEYF "$line\n";
      $newchan=0;
    } else {
      print KEYF "$_\n";
    }
  }
  if ($newchan) {
    print KEYF "$line\n";
  }
  close (KEYF);
  loadkeys;
  Irssi::active_win()->print($status_col."key set to $variables_col$key".
			     "$status_col for channel $variables_col$curchan");
  return 1 ;
}

sub delkey
{
  my ($data, $server, $channel) = @_;
  my $curchan = $channel->{name};
  my $curserv = $server->{address};

  my $serv;
  my $chan;

  open (KEYF, ">$kfile");
  foreach(@keys) {
    s/\n//g;
    ($serv,$chan)=/^(.*?)\:(.*?)\:/;
   unless ($curserv =~ /$serv/ and $curchan=~/^$chan$/) {
      print KEYF "$_\n";
    }
  }
  close (KEYF);
  Irssi::active_win()->print($status_col."key for channel $variables_col".
			     "$curchan$status_col deleted");
  loadkeys;
  return 1 ;
}

sub showkey {
  my (undef, $server, $channel) = @_;
  if (! $channel) { return 1; }
  my $curchan = $channel->{name};
  my $curserv = $server->{address};

  getkey($curserv,$curchan);

  Irssi::active_win()->print($status_col."current key is : ".
			     $variables_col.$key);
  return 1 ;
}

sub enc
{
  my ($curserv,$curchan, $in) = @_;
  my $prng1="";
  my $prng2="";

  # copy & paste from former sub blow()

  for (my $i=0;$i<4;$i++) {
    $prng1.=substr($alnum,int(rand(61)),1);
    $prng2.=substr($alnum,int(rand(61)),1);
  }


  getkey($curserv,$curchan);

  $cipher->start('encrypting');

  my $tbout = compress($in);
  my $i;
  for ($i=0;$i<$paranoia;$i++) {
    $tbout = $prng1.$tbout;
    $tbout = $cipher->encrypt($tbout);
    $tbout .= $prng2;
    # Some versions of Crypt::CBC prepend the IV by default, and all we need
    # to do is to get rid of the RandomIV prefix.  For others, we need to
    # add the IV by hand.
    if ($tbout =~ /RandomIV/) {
      $tbout =~ s/^.{8}//;
    } else {
      $tbout = $cipher->get_initialization_vector().$tbout;
    }
  }

  $tbout = encode_base64($tbout);
  $tbout = unpack("H*",$tbout);
  $tbout = $header." ".$tbout;
  $tbout =~ s/=+$//;	

  $cipher->finish();

  return (length($tbout),$tbout);

}

sub irclen
{
  my ($len,$curchan,$nick,$userhost) = @_;

  # calculate length of "PRIVMSG #blowtest :{blow} 4b7257724a ..." 
  # does not exceed it may not exceed 511 bytes result gets handled by
  # caller.

  return ($len + length($curchan) + length("PRIVMSG : ")
	  + length($userhost) + 1 + length($nick) );
}
sub recurs
{
  my ($server,$curchan,$in) = @_;

  # 1. devide input line by 2.                    <--|
  #    into two halfes, called $first and $second.   |
  # 2. try to decrease $first to a delimiting " "    |
  #    but only try on the last 8 bytes              ^
  # 3. encrypt $first                                |
  #    if result too long, call sub recurs($first)----
  # 4. encrypt $second                               ^
  #    if result too long, call sub recurs($second)--|
  # 5. pass back encrypted halfes as reference
  #    to an array.


  my $half = length($in)/2-1;
  my $first = substr($in,0,$half);
  my $second = substr($in,$half,$half+3);
  if ( (my $pos = rindex($first," ",length($first)-8) ) != -1)
  {
	$second = substr($first,$pos+1,length($first)-$pos) . $second;
        $first = substr($first,0,$pos);
  }

  my @a;

  my ($len,$probablyout);

  ($len,$probablyout) = enc($server->{address},$curchan,$first);

  if ( irclen($len,$curchan,$server->{nick},$server->{userhost}) > 510)
  {
    my @b=recurs($server,$curchan,$first);
    push(@a,@{$b[0]});
  } else {
    push(@a,$probablyout);
  }

  ($len,$probablyout) = enc($server->{address},$curchan,$second);
  if ( irclen($len,$curchan,$server->{nick},$server->{userhost}) > 510)
  {
    my @b = recurs($server,$curchan,$second);
    push(@a,@{$b[0]});
  } else {
    push(@a,$probablyout);
  }
  return \@a;

}


sub printout
{
   my ($aref,$server,$curchan) = @_;

   # encrypted lines get stored [ '{blow} yxcvasfd', '{blow} qewrdf', ... ];
   # in an arrayref

   foreach(@{$aref})
   {
     	$server->command("/^msg -$server->{tag} $curchan ".$_);
   }
}

sub enhanced_printing
{
  my ($server,$curchan,$in) = @_;

  # calls the recursing sub recurs ... and 
  my $arref = recurs($server,$curchan,$in);
  # print out.
  printout($arref,$server,$curchan);

}

sub blow
{
  my ($data, $server, $channel) = @_;
  if (! $channel) { return 1;}
  my $in = $data ;
  my $nick = $server->{nick};
  my $curchan = $channel->{name};
  my $curserv = $server->{address};

  my ($len,$encrypted_message) = enc($curserv,$curchan,$in);

  $server->print($channel->{name}, 
		 "$default_nick_col<$own_nick_col$nick$default_nick_col".
		 "$encrypt_appendix> $msg_col$in",MSGLEVEL_CLIENTCRAP);

  $len = length($encrypted_message); # kept for debugging

  if ( irclen($len,$curchan,$server->{nick},$server->{userhost}) > 510)
  {
    # if complete message too long .. see sub irclen
    enhanced_printing($server,$curchan,$data);
  } else {
    # everything is fine, just print out
    $server->command("/^msg -$server->{tag} $curchan $encrypted_message");
  }

  return 1 ;
}

sub infoline
{
  my ($server, $data, $nick, $address) = @_;

  my ($channel,$text,$msgline,$msgnick,$curchan,$curserv);

  if ( ! defined($address) ) # dcc chat
  {
    $msgline = $data;
    $curserv = $server->{server}->{address};
    $channel = $curchan = "=".$nick;
    $msgnick = $nick;
    $server  = $server->{server};
  } else 
  {
    ($channel, $text) = $data =~ /^(\S*)\s:(.*)/;
    $msgline = $text;
    $msgnick = $server->{nick};
    $curchan = $channel;
    $curserv = $server->{address};
  }

  if ($msgline =~ m/^$header/) {
    my $out = $msgline;
    $out =~ s/\0030[0-9]//g;
    $out =~ s/^$header\s*(.*)/$1/;

    if ($msgnick eq $channel)
    {
       $curchan = $channel = $nick;
    }

    getkey($curserv,$curchan);

    $cipher->start('decrypting');
    $out = pack("H*",$out);
    $out = decode_base64($out);

    my $i;
    eval {
      for ($i=0;$i<$paranoia;$i++) {
        $out = substr($out,0,(length($out)-4));
        # restore RandomIV
        $out = 'RandomIV'.$out;
        $out = $cipher->decrypt($out);
        $out = substr($out,4);
      }
      $out = uncompress($out);

    $cipher->finish;
    };
    $out = "blowjob error: ".$@ if $@;

    if(length($out))
    {
      $out = "$msg_col$out";
      $data =~ s/$msgline/$out/;
      Irssi::signal_continue($server, $data,
			     $nick.$decrypt_appendix, $address);
    }
    return 1;

  }
  return 0 ;
}

sub dccinfoline
{
  my ($server, $data) = @_;
  infoline($server,$data,$server->{nick},undef);
}
my %permchans={};
sub perm
{
   my ($data, $server, $channel) = @_;
   if (! $channel) { return 1; }
   my $curchan = $channel->{name};
   my $curserv = $server->{address};

   if ( exists($permchans{$curserv}{$curchan}) 
	&& $permchans{$curserv}{$curchan} == 1) {
    delete $permchans{$curserv}{$curchan};
    Irssi::active_win()->print($status_col.
			       "not crypting to $variables_col$curchan".
			       "$status_col on ".
			       "$variables_col$curserv$status_col anymore");
  } else {
    $permchans{$curserv}{$curchan} = 1;
    Irssi::active_win()->print($status_col.
			       "crypting to $variables_col$curchan ".
			       "on $variables_col$curserv");
  }
  return 1;
}
sub myline
{
  my ($data, $server, $channel) = @_;
  if (! $channel) { return 1; }
  my $curchan = $channel->{name};
  my $curserv = $server->{address};
  my $line = shift;
  chomp($line);
  if (length($line) == 0)
  {
    return;
  }
  my $gotchan = 0;
  foreach(@keys) {
    s/\n//g;
    my ($serv,$chan,undef,undef)=split /:/;
    if (($curserv =~ /$serv/ 
	 && $curchan =~ /^$chan$/ 
	 && exists($permchans{$curserv}{$curchan}) 
	 && $permchans{$curserv}{$curchan} == 1) 
	|| (exists($permchans{$curserv}{$curchan}) 
	    && $permchans{$curserv}{$curchan} == 1))
      {
	$gotchan = 1;
      }
  }
  if ($gotchan)
    {
      blow($line,$server,$channel);
      Irssi::signal_stop();
      return 1;
    }
}

sub reloadconf
{
  loadconf;
  loadkeys;
}
sub help
{
  Irssi::print($status_col."[\00303bl\003090\00303wjob".$status_col.
	       "]$variables_col script :\n");
  Irssi::print("$variables_col/setkey <newkey> [<paranoia>] :".
	       "$status_col new key for current channel\n");
  Irssi::print("$variables_col/delkey                       :".
	       "$status_col delete key for current channel");
  Irssi::print("$variables_col/showkey                      :".
	       "$status_col show your current key\n");
  Irssi::print("$variables_col/blow   <line>                :".
	       "$status_col send crypted line\n");
  Irssi::print("$variables_col/perm                         :".
	       "$status_col flag current channel as permanently crypted\n");
  Irssi::print("$variables_col/bconf                        :".
	       "$status_col reload blowjob.conf\n");

  return 1 ;
}

Irssi::print("blowjob script $VERSION") ;
Irssi::print("\n".$status_col."[\00303bl\003090\00303wjob$status_col] ".
	     "v$VERSION$variables_col script loaded\n\n");
Irssi::print($status_col."- type $variables_col/blowhelp$status_col ".
	     "for options\n") ;
Irssi::print($status_col."- paranoia level is      :".
	     " $variables_col$paranoia\n") ;
Irssi::print($status_col."- generic key is         : ".
	     "$variables_col$key\n") ;
Irssi::print("\n".$status_col.
	     "* please read script itself for documentation\n");
Irssi::signal_add("event privmsg","infoline") ;
Irssi::signal_add("dcc chat message","dccinfoline");
Irssi::command_bind("blowhelp","help") ;
Irssi::command_bind("setkey","setkey") ;
Irssi::command_bind("delkey","delkey");
Irssi::command_bind("blow","blow") ;
Irssi::command_bind("showkey","showkey") ;
Irssi::command_bind("perm","perm") ;
Irssi::command_bind("bconf","reloadconf") ;
Irssi::signal_add("send text","myline") ;