diff options
| author | Alexander Færøy | 2014-05-31 13:10:46 +0200 | 
|---|---|---|
| committer | Alexander Færøy | 2014-05-31 13:10:46 +0200 | 
| commit | 2d0759e6ca5767b48bcc85bf38c2c43d5f0b63b1 (patch) | |
| tree | 1c5e6d817c88e67b46e216a50e0aef5428bf63df /scripts/blowjob.pl | |
| parent | 2d080422d79d1fd49d6c5528593ccaaff9bfc583 (diff) | |
| download | scripts.irssi.org-2d0759e6ca5767b48bcc85bf38c2c43d5f0b63b1.tar.bz2 | |
Import scripts from scripts.irssi.org
Diffstat (limited to 'scripts/blowjob.pl')
| -rw-r--r-- | scripts/blowjob.pl | 558 | 
1 files changed, 558 insertions, 0 deletions
| diff --git a/scripts/blowjob.pl b/scripts/blowjob.pl new file mode 100644 index 0000000..27e2fcc --- /dev/null +++ b/scripts/blowjob.pl @@ -0,0 +1,558 @@ +#!/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 = "0.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/', +); + + +############# 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("\00305> $fconf not found, setting to defaults\n"); +    Irssi::print("\00305> 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"; +    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; +    } +  } +  Irssi::print("\00314- 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("\00314- keys reloaded (Total:\00315 ".scalar @keys."\00314)\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,'Blowfish',undef); +} + +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("\00314IRC 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("\00314key set to \00315$key\00314 for channel \00315$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("\00314key for channel \00315$curchan\00314 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("\00314current key is : \00315$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; +    # don't wan't to see "RandomIV" +    $tbout =~ s/^.{8}//; +  } + +  $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}, "<$nick|{crypted}> \00311$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; +    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; + +    if(length($out)) +    { +       $server->print($channel, "<$nick|{uncrypted}> \00311$out", MSGLEVEL_CLIENTCRAP); +       Irssi::signal_stop(); +    } +    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("\00314not crypting to \00315$curchan\00314 on \00315$curserv\00314 anymore"); +  } else { +    $permchans{$curserv}{$curchan} = 1; +    Irssi::active_win()->print("\00314crypting to \00315$curchan on \00315$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("\00314[\00303bl\003090\00303wjob\00314]\00315 script :\n"); +  Irssi::print("\00315/setkey <newkey> [<paranoia>] :\00314 new key for current channel\n") ; +  Irssi::print("\00315/delkey                       :\00314 delete key for current channel"); +  Irssi::print("\00315/showkey                      :\00314 show your current key\n") ; +  Irssi::print("\00315/blow   <line>                :\00314 send crypted line\n") ; +  Irssi::print("\00315/perm                         :\00314 flag current channel as permanently crypted\n") ; +  Irssi::print("\00315/bconf                        :\00314 reload blowjob.conf\n") ; + +  return 1 ; +} + +Irssi::print("blowjob script $VERSION") ; +Irssi::print("\n\00314[\00303bl\003090\00303wjob\00314] v$VERSION\00315 script loaded\n\n"); +Irssi::print("\00314- type \00315/blowhelp\00314 for options\n") ; +Irssi::print("\00314- paranoia level is      : \00315$paranoia\n") ; +Irssi::print("\00314- generic key is         : \00315$key\n") ; +Irssi::print("\n\00314* 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") ; | 
