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