1#!/usr/local/bin/perl -w
2use strict;
3
4# BlowJob 0.9.1, a crypto script - ported from xchat
5# was based on rodney mulraney's crypt
6# changed crypting method to Blowfish+Base64+randomness+Z-compression
7# needs :
8#         Crypt::CBC,
9#         Crypt::Blowfish,
10#         MIME::Base64,
11#         Compress::Zlib
12#
13# crypted format is :
14# HEX(Base64((paranoia-factor)*(blowfish(RANDOM+Zcomp(string))+RANDOM)))
15#
16# 04-22-2015 Updated for compatibility with current Crypt::CBC
17# 10-03-2004 Removed seecrypt, fixed two minor bugs
18# 09-03-2004 Supporting multiline messages now.
19# 08-03-2004 Lots of bugfixes on the irssi version by Thomas Reifferscheid
20# 08-03-2004 CONF FILE FORMAT CHANGED
21#
22#            from server:channel:key:paranoia
23#            to   server:channel:paranoia:key
24#
25#            /perm /bconf /setkey /showkey working now
26#            keys may contain colons ":" now.
27#
28#
29# 06-12-2001 Added default umask for blowjob.keys
30# 05-12-2001 Added paranoia support for each key
31# 05-12-2001 Added conf file support
32# 05-12-2001 Added delkey and now can handle multi-server/channel keys
33# 05-12-2001 permanent crypting to a channel added
34# 05-12-2001 Can now handle multi-channel keys
35# just /setkey <key> on the channel you are to associate a channel with a key
36#
37# --- conf file format ---
38#
39# # the generic key ( when /setkey has not been used )
40# key:            generic key value
41# # header that marks a crypted sentance
42# header:         {header}
43# # enable wildcards for multiserver entries ( useful for OPN for example )
44# wildcardserver: yes
45#
46# --- end of conf file ---
47#
48# iMil <imil@gcu-squad.org>
49# skid <skid@gcu-squad.org>
50# Foxmask <odemah@gcu-squad.org>
51# Thomas Reifferscheid <blowjob@reifferscheid.org>
52
53use Crypt::CBC;
54use Crypt::Blowfish;
55use MIME::Base64;
56use Compress::Zlib;
57
58use Irssi::Irc;
59use Irssi;
60use vars qw($VERSION %IRSSI $cipher);
61
62$VERSION = "0.9.0";
63%IRSSI = (
64    authors => 'iMil,Skid,Foxmask,reiffert',
65    contact => 'imil@gcu-squad.org,blowjob@reifferscheid.org,#blowtest@freenode',
66    name => 'blowjob',
67    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.',
68    license => 'GNU GPL',
69    url => 'http://ftp.gcu-squad.org/misc/',
70);
71
72
73############# IRSSI README AREA #################################
74#To install this script just do
75#/script load ~/blowjob-irssi.pl
76#  and
77#/blowhelp
78#  to read all the complete feature of the script :)
79#To uninstall it do
80#/script unload blowjob-irssi
81################################################################
82
83
84my $key = 'very poor key' ; # the default key
85my $header = "{blow}";
86# Crypt loops, 1 should be enough for everyone imho ;)
87# please note with a value of 4, a single 4-letter word can generate
88# a 4 line crypted sentance
89my $paranoia = 1;
90# add a server mask by default ?
91my $enableWildcard="yes";
92
93my $alnum = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789";
94
95my $gkey;
96sub loadconf
97{
98  my $fconf =Irssi::get_irssi_dir()."/blowjob.conf";
99  my @conf;
100  open (CONF, q{<}, $fconf);
101
102  if (!( -f CONF)) {
103    Irssi::print("\00305> $fconf not found, setting to defaults\n");
104    Irssi::print("\00305> creating $fconf with default values\n\n");
105    close(CONF);
106    open(CONF, q{>}, $fconf);
107    print CONF "key:			$key\n";
108    print CONF "header:			$header\n";
109    print CONF "wildcardserver:		$enableWildcard\n";
110    close(CONF);
111    return 1;
112  }
113
114  @conf=<CONF>;
115  close(CONF);
116
117  my $current;
118  foreach(@conf) {
119    $current = $_;
120    $current =~ s/\n//g;
121    if ($current =~ m/key/) {
122      $current =~ s/.*\:[\ \t]*//;
123      $key = $current;
124      $gkey = $key;
125    }
126    if ($current =~ m/header/) {
127      $current =~ s/.*\:[\s\t]*\{(.*)\}.*/{$1}/;
128      $header = $current;
129    }
130    if ($current =~ m/wildcardserver/) {
131      $current =~ s/.*\:[\ \t]*//;
132      $enableWildcard = $current;
133    }
134  }
135  Irssi::print("\00314- configuration file loaded\n");
136  return 1;
137}
138loadconf;
139
140my $kfile ="$ENV{HOME}/.irssi/blowjob.keys";
141my @keys;
142$gkey=$key;
143my $gparanoia=$paranoia;
144
145sub loadkeys
146{
147  if ( -e "$kfile" ) {
148    open (KEYF, q{<}, $kfile);
149    @keys = <KEYF>;
150    close (KEYF);
151  }
152  Irssi::print("\00314- keys reloaded (Total:\00315 ".scalar @keys."\00314)\n");
153  return 1;
154}
155loadkeys;
156
157sub getkey
158{
159  my ($curserv, $curchan) = @_;
160
161  my $gotkey=0;
162  my $serv;
163  my $chan;
164  my $fkey;
165
166  foreach(@keys) {
167    chomp;                                            # keys can contain ":" now. Note:
168    my ($serv,$chan,$fparanoia,$fkey)=split /:/,$_,4; # place of paranoia has changed!
169    if ( $curserv =~ /$serv/ and $curchan eq $chan ) {
170      $key= $fkey;
171      $paranoia=$fparanoia;
172      $gotkey=1;
173    }
174  }
175  if (!$gotkey) {
176    $key=$gkey;
177    $paranoia=$gparanoia;
178  }
179  $cipher=new Crypt::CBC(-key=> $key, -cipher=> 'Blowfish', -header => 'randomiv');
180}
181
182sub setkey
183{
184  my (undef,$server, $channel) = @_;
185  if (! $channel) { return 1; }
186  my $curchan = $channel->{name};
187  my $curserv = $server->{address};
188  # my $key = $data;
189
190  my $fparanoia;
191
192  my $newchan=1;
193  umask(0077);
194  unless ($_[0] =~ /( +\d$)/) {
195     $_[0].= " $gparanoia";
196  }
197  ($key, $fparanoia) = ($_[0] =~ /(.*) +(\d)/);
198
199  if($enableWildcard =~ /[Yy][Ee][Ss]/) {
200      $curserv =~ s/(.*?)\./(.*?)\./;
201    Irssi::print("\00314IRC server wildcards enabled\n");
202  }
203
204  # Note, place of paranoia has changed!
205  my $line="$curserv:$curchan:$fparanoia:$key";
206
207  open (KEYF, q{>}, $kfile);
208  foreach(@keys) {
209    s/\n//g;
210    if (/^$curserv\:$curchan\:/) {
211      print KEYF "$line\n";
212      $newchan=0;
213    } else {
214      print KEYF "$_\n";
215    }
216  }
217  if ($newchan) {
218    print KEYF "$line\n";
219  }
220  close (KEYF);
221  loadkeys;
222  Irssi::active_win()->print("\00314key set to \00315$key\00314 for channel \00315$curchan");
223  return 1 ;
224}
225
226sub delkey
227{
228  my ($data, $server, $channel) = @_;
229  my $curchan = $channel->{name};
230  my $curserv = $server->{address};
231
232  my $serv;
233  my $chan;
234
235  open (KEYF, q{>}, $kfile);
236  foreach(@keys) {
237    s/\n//g;
238    ($serv,$chan)=/^(.*?)\:(.*?)\:/;
239   unless ($curserv =~ /$serv/ and $curchan=~/^$chan$/) {
240      print KEYF "$_\n";
241    }
242  }
243  close (KEYF);
244  Irssi::active_win()->print("\00314key for channel \00315$curchan\00314 deleted");
245  loadkeys;
246  return 1 ;
247}
248
249sub showkey {
250  my (undef, $server, $channel) = @_;
251  if (! $channel) { return 1; }
252  my $curchan = $channel->{name};
253  my $curserv = $server->{address};
254
255  getkey($curserv,$curchan);
256
257  Irssi::active_win()->print("\00314current key is : \00315$key");
258  return 1 ;
259}
260
261sub enc
262{
263  my ($curserv,$curchan, $in) = @_;
264  my $prng1="";
265  my $prng2="";
266
267  # copy & paste from former sub blow()
268
269  for (my $i=0;$i<4;$i++) {
270    $prng1.=substr($alnum,int(rand(61)),1);
271    $prng2.=substr($alnum,int(rand(61)),1);
272  }
273
274
275  getkey($curserv,$curchan);
276
277  $cipher->start('encrypting');
278
279  my $tbout = compress($in);
280  my $i;
281  for ($i=0;$i<$paranoia;$i++) {
282    $tbout = $prng1.$tbout;
283    $tbout = $cipher->encrypt($tbout);
284    $tbout .= $prng2;
285  }
286
287  $tbout = encode_base64($tbout);
288  $tbout = unpack("H*",$tbout);
289  $tbout = $header." ".$tbout;
290  $tbout =~ s/=+$//;
291
292  $cipher->finish();
293
294  return (length($tbout),$tbout);
295
296}
297
298sub irclen
299{
300  my ($len,$curchan,$nick,$userhost) = @_;
301
302  # calculate length of "PRIVMSG #blowtest :{blow} 4b7257724a ..." does not exceed
303  # it may not exceed 511 bytes
304  # result gets handled by caller.
305
306  return ($len + length($curchan) + length("PRIVMSG : ") + length($userhost) + 1 + length($nick) );
307}
308sub recurs
309{
310  my ($server,$curchan,$in) = @_;
311
312  # 1. devide input line by 2.                    <--|
313  #    into two halfes, called $first and $second.   |
314  # 2. try to decrease $first to a delimiting " "    |
315  #    but only try on the last 8 bytes              ^
316  # 3. encrypt $first                                |
317  #    if result too long, call sub recurs($first)----
318  # 4. encrypt $second                               ^
319  #    if result too long, call sub recurs($second)--|
320  # 5. pass back encrypted halfes as reference
321  #    to an array.
322
323
324  my $half = length($in)/2-1;
325  my $first = substr($in,0,$half);
326  my $second = substr($in,$half,$half+3);
327  if ( (my $pos = rindex($first," ",length($first)-8) ) != -1)
328  {
329	$second = substr($first,$pos+1,length($first)-$pos) . $second;
330        $first = substr($first,0,$pos);
331  }
332
333  my @a;
334
335  my ($len,$probablyout);
336
337  ($len,$probablyout) = enc($server->{address},$curchan,$first);
338
339  if ( irclen($len,$curchan,$server->{nick},$server->{userhost}) > 510)
340  {
341    my @b=recurs($server,$curchan,$first);
342    push(@a,@{$b[0]});
343  } else {
344    push(@a,$probablyout);
345  }
346
347  ($len,$probablyout) = enc($server->{address},$curchan,$second);
348  if ( irclen($len,$curchan,$server->{nick},$server->{userhost}) > 510)
349  {
350    my @b = recurs($server,$curchan,$second);
351    push(@a,@{$b[0]});
352  } else {
353    push(@a,$probablyout);
354  }
355  return \@a;
356
357}
358
359
360sub printout
361{
362   my ($aref,$server,$curchan) = @_;
363
364   # encrypted lines get stored [ '{blow} yxcvasfd', '{blow} qewrdf', ... ];
365   # in an arrayref
366
367   foreach(@{$aref})
368   {
369     	$server->command("/^msg -$server->{tag} $curchan ".$_);
370   }
371}
372
373sub enhanced_printing
374{
375  my ($server,$curchan,$in) = @_;
376
377  # calls the recursing sub recurs ... and
378  my $arref = recurs($server,$curchan,$in);
379  # print out.
380  printout($arref,$server,$curchan);
381
382}
383
384sub blow
385{
386  my ($data, $server, $channel) = @_;
387  if (! $channel) { return 1;}
388  my $in = $data ;
389  my $nick = $server->{nick};
390  my $curchan = $channel->{name};
391  my $curserv = $server->{address};
392
393  my ($len,$encrypted_message) = enc($curserv,$curchan,$in);
394
395  $server->print($channel->{name}, "<$nick|{crypted}> \00311$in",MSGLEVEL_CLIENTCRAP);
396
397  $len = length($encrypted_message); # kept for debugging
398
399  if ( irclen($len,$curchan,$server->{nick},$server->{userhost}) > 510)
400  {
401    # if complete message too long .. see sub irclen
402    enhanced_printing($server,$curchan,$data);
403  } else {
404    # everything is fine, just print out
405    $server->command("/^msg -$server->{tag} $curchan $encrypted_message");
406  }
407
408  return 1 ;
409}
410
411sub infoline
412{
413  my ($server, $data, $nick, $address) = @_;
414
415  my ($channel,$text,$msgline,$msgnick,$curchan,$curserv);
416
417  if ( ! defined($address) ) # dcc chat
418  {
419    $msgline = $data;
420    $curserv = $server->{server}->{address};
421    $channel = $curchan = "=".$nick;
422    $msgnick = $nick;
423    $server  = $server->{server};
424  } else
425  {
426    ($channel, $text) = $data =~ /^(\S*)\s:(.*)/;
427    $msgline = $text;
428    $msgnick = $server->{nick};
429    $curchan = $channel;
430    $curserv = $server->{address};
431  }
432
433  if ($msgline =~ m/^$header/) {
434    my $out = $msgline;
435    $out =~ s/\0030[0-9]//g;
436    $out =~ s/^$header\s*(.*)/$1/;
437
438    if ($msgnick eq $channel)
439    {
440       $curchan = $channel = $nick;
441    }
442
443    getkey($curserv,$curchan);
444
445    $cipher->start('decrypting');
446    $out = pack("H*",$out);
447    $out = decode_base64($out);
448
449    my $i;
450    for ($i=0;$i<$paranoia;$i++) {
451      $out = substr($out,0,(length($out)-4));
452      $out = $cipher->decrypt($out);
453      $out = substr($out,4);
454    }
455    $out = uncompress($out);
456
457    $cipher->finish;
458
459    if(length($out))
460    {
461       $server->print($channel, "<$nick|{uncrypted}> \00311$out", MSGLEVEL_CLIENTCRAP);
462       Irssi::signal_stop();
463    }
464    return 1;
465
466  }
467  return 0 ;
468}
469
470sub dccinfoline
471{
472  my ($server, $data) = @_;
473  infoline($server,$data,$server->{nick},undef);
474}
475my %permchans={};
476sub perm
477{
478   my ($data, $server, $channel) = @_;
479   if (! $channel) { return 1; }
480   my $curchan = $channel->{name};
481   my $curserv = $server->{address};
482
483   if ( exists($permchans{$curserv}{$curchan}) && $permchans{$curserv}{$curchan} == 1) {
484    delete $permchans{$curserv}{$curchan};
485    Irssi::active_win()->print("\00314not crypting to \00315$curchan\00314 on \00315$curserv\00314 anymore");
486  } else {
487    $permchans{$curserv}{$curchan} = 1;
488    Irssi::active_win()->print("\00314crypting to \00315$curchan on \00315$curserv");
489  }
490  return 1;
491}
492sub myline
493{
494  my ($data, $server, $channel) = @_;
495  if (! $channel) { return 1; }
496  my $curchan = $channel->{name};
497  my $curserv = $server->{address};
498  my $line = shift;
499  chomp($line);
500  if (length($line) == 0)
501  {
502    return;
503  }
504  my $gotchan = 0;
505  foreach(@keys) {
506    s/\n//g;
507    my ($serv,$chan,undef,undef)=split /:/;
508    if ( ($curserv =~ /$serv/ && $curchan =~ /^$chan$/ && exists($permchans{$curserv}{$curchan}) && $permchans{$curserv}{$curchan} == 1) || (exists($permchans{$curserv}{$curchan}) && $permchans{$curserv}{$curchan} == 1))
509    {
510      $gotchan = 1;
511    }
512  }
513  if ($gotchan)
514  {
515
516    blow($line,$server,$channel);
517    Irssi::signal_stop();
518    return 1;
519  }
520}
521
522sub reloadconf
523{
524  loadconf;
525  loadkeys;
526}
527sub help
528{
529  Irssi::print("\00314[\00303bl\003090\00303wjob\00314]\00315 script :\n");
530  Irssi::print("\00315/setkey <newkey> [<paranoia>] :\00314 new key for current channel\n") ;
531  Irssi::print("\00315/delkey                       :\00314 delete key for current channel");
532  Irssi::print("\00315/showkey                      :\00314 show your current key\n") ;
533  Irssi::print("\00315/blow   <line>                :\00314 send crypted line\n") ;
534  Irssi::print("\00315/perm                         :\00314 flag current channel as permanently crypted\n") ;
535  Irssi::print("\00315/bconf                        :\00314 reload blowjob.conf\n") ;
536
537  return 1 ;
538}
539
540Irssi::print("blowjob script $VERSION") ;
541Irssi::print("\n\00314[\00303bl\003090\00303wjob\00314] v$VERSION\00315 script loaded\n\n");
542Irssi::print("\00314- type \00315/blowhelp\00314 for options\n") ;
543Irssi::print("\00314- paranoia level is      : \00315$paranoia\n") ;
544Irssi::print("\00314- generic key is         : \00315$key\n") ;
545Irssi::print("\n\00314* please read script itself for documentation\n");
546Irssi::signal_add("event privmsg","infoline") ;
547Irssi::signal_add("dcc chat message","dccinfoline");
548Irssi::command_bind("blowhelp","help") ;
549Irssi::command_bind("setkey","setkey") ;
550Irssi::command_bind("delkey","delkey");
551Irssi::command_bind("blow","blow") ;
552Irssi::command_bind("showkey","showkey") ;
553Irssi::command_bind("perm","perm") ;
554Irssi::command_bind("bconf","reloadconf") ;
555Irssi::signal_add("send text","myline") ;
556