1#!/usr/local/bin/perl -w 2 3## Bugreports and Licence disclaimer. 4# 5# For bugreports and other improvements contact Geert Hauwaerts <geert@irssi.org> 6# 7# This program is free software; you can redistribute it and/or modify 8# it under the terms of the GNU General Public License as published by 9# the Free Software Foundation; either version 2 of the License, or 10# (at your option) any later version. 11# 12# This program is distributed in the hope that it will be useful, 13# but WITHOUT ANY WARRANTY; without even the implied warranty of 14# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 15# GNU General Public License for more details. 16# 17# You should have received a copy of the GNU General Public License 18# along with this script; if not, write to the Free Software 19# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA 20# 21## 22 23use strict; 24use Irssi; 25use vars qw($VERSION %IRSSI); 26 27$VERSION = "1.03"; 28 29%IRSSI = ( 30 authors => 'Geert Hauwaerts', 31 contact => 'geert@irssi.org', 32 name => 'fakectcp.pl', 33 description => 'This script sends fake ctcp replies to a client using a fake ctcp list.', 34 license => 'GNU General Public License', 35 url => 'http://irssi.hauwaerts.be/default.pl', 36 changed => 'Wed Sep 17 23:00:11 CEST 2003', 37); 38 39my @fakectcp = (); 40my $fakectcp_file = "fctcplist"; 41my $irssidir = Irssi::get_irssi_dir(); 42 43my $help = <<EOF; 44 45Usage: (all on one line) 46/FCTCP [-add||-replace <ctcp-item> <ctcp-reply>] [-del <ctcp-item>] [-list] [-help] 47 48-add: Add a new fake ctcp-reply to the list. 49-del: Delete a fake ctcp-reply from the list. 50-list: Display the contents of the fake ctcp-reply list. 51-help: Display this useful little helpfile. 52-replace: Replace an existing fake reply with a new one. If the old one doesn't exist, the new one will be added by default. 53 54Examples: (all on one line) 55/FCTCP -add CHRISTEL We all love christel, don't we! :) 56/FCTCP -add LOCATION I'm at home, reading some helpfiles. 57 58/FCTCP -del CHRISTEL 59/FCTCP -del LOCATION 60 61Note: The caps are not obligated. The default parameter is -list. 62EOF 63 64Irssi::theme_register([ 65 'fctcp_info', ' # ctcpitem ctcpreply', 66 'fctcp_empty', '%R>>%n %_FCTCP:%_ Your fake ctcp list is empty.', 67 'fctcp_added', '%R>>%n %_FCTCP:%_ Added %_$0%_ ($1) to the fake ctcp list.', 68 'fctcp_replaced', '%R>>%n %_FCTCP:%_ Replaced the old fake reply %_$0%_ with the new one ($1)', 69 'fctcp_delled', '%R>>%n %_FCTCP:%_ Deleted %_$0%_ from the fake ctcp list.', 70 'fctcp_nfound', '%R>>%n %_FCTCP:%_ Can\'t find $0 in the fake ctcp list.', 71 'fctcp_delusage', '%R>>%n %_FCTCP:%_ Usage: /FCTCP -del <ctcp-item>', 72 'fctcp_usage', '%R>>%n %_FCTCP:%_ Usage: /FCTCP -add <ctcp-item> <ctcp-reply>', 73 'fctcp_repusage', '%R>>%n %_FCTCP:%_ Usage: /FCTCP -replace <ctcp-item> <ctcp-reply>', 74 'fctcp_nload', '%R>>%n %_FCTCP:%_ Could not load the fake ctcp list.', 75 'fctcp_request', '%R>>%n %_FCTCP:%_ Used the fake reply %_$1%_ on %_$0%_', 76 'fctcp_loaded', '%R>>%n %_FCTCP:%_ The fake reply %_$0%_ already exists, use %_/FCTCP -del $0%_ to remove it from the list.', 77 'fctcp_print', '$[!-2]0 $[20]1 $2', 78 'fctcp_help', '$0', 79 'loaded', '%R>>%n %_Scriptinfo:%_ Loaded $0 version $1 by $2.' 80]); 81 82sub ctcpreply { 83 84 my ($server, $data, $nick, $address, $target) = @_; 85 my ($findex); 86 87 $data = lc($data); 88 89 return unless (lc($server->{nick}) eq lc($target)); 90 91 if (!already_loaded($data)) { 92 $findex = check_loaded($data); 93 $server->command("^NCTCP $nick $data $fakectcp[$findex]->{reply}"); 94 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_request', $nick, $data); 95 Irssi::signal_stop(); 96 } 97} 98 99sub new_fctcp { 100 101 my $fctcp = {}; 102 103 $fctcp->{item} = shift; 104 $fctcp->{reply} = shift; 105 106 return $fctcp; 107} 108 109sub already_loaded { 110 111 my ($item) = @_; 112 my $loaded = check_loaded($item); 113 114 if ($loaded > -1) { 115 return 0; 116 } 117 118 return 1; 119} 120 121sub check_loaded { 122 123 my ($item) = @_; 124 125 $item = lc($item); 126 127 for (my $loaded = 0; $loaded < @fakectcp; ++$loaded) { 128 return $loaded if (lc($fakectcp[$loaded]->{item}) eq $item); 129 } 130 131 return -1; 132} 133 134sub load_fakectcplist { 135 136 my ($file) = @_; 137 138 @fakectcp = (); 139 140 if (-e $file) { 141 local *F; 142 open(F, "<", $file); 143 local $/ = "\n"; 144 145 while (<F>) { 146 chop; 147 my $new_fctcp = new_fctcp(split("\t")); 148 149 if (($new_fctcp->{item} ne "") && ($new_fctcp->{reply} ne "")) { 150 push(@fakectcp, $new_fctcp); 151 } 152 } 153 154 close(F); 155 } else { 156 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_nload'); 157 } 158} 159 160sub save_fakectcplist { 161 162 my ($file) = @_; 163 164 local *F; 165 open(F, ">", $file) or die "Could not load the fake ctcpreply list for writing"; 166 167 for (my $n = 0; $n < @fakectcp; ++$n) { 168 print(F join("\t", $fakectcp[$n]->{item}, $fakectcp[$n]->{reply}) . "\n"); 169 } 170 171 close(F); 172} 173 174sub addfakectcp { 175 176 my ($ctcpitem, $ctcpreply) = split (" ", $_[0], 2); 177 178 if (($ctcpitem eq "") || ($ctcpreply eq "")) { 179 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_usage'); 180 return; 181 } elsif (!already_loaded($ctcpitem)) { 182 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_loaded', $ctcpitem); 183 return; 184 } 185 186 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_added', $ctcpitem, $ctcpreply); 187 push(@fakectcp, new_fctcp($ctcpitem, $ctcpreply)); 188 save_fakectcplist("$irssidir/$fakectcp_file"); 189} 190 191sub delfakectcp { 192 193 my ($fdata) = @_; 194 my ($fdataindex); 195 196 if ($fdata eq "") { 197 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_delusage'); 198 return; 199 } 200 201 for (my $index = 0; $index < @fakectcp; ++$index) { 202 if (lc($fakectcp[$index]->{item}) eq $fdata) { 203 $fdataindex = splice(@fakectcp, $index, 1); 204 } 205 } 206 207 if ($fdataindex) { 208 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_delled', $fdata); 209 save_fakectcplist("$irssidir/$fakectcp_file"); 210 } else { 211 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_nfound', $fdata); 212 } 213} 214 215sub replacefakectcp { 216 217 my ($ctcpitem, $ctcpreply) = split (" ", $_[0], 2); 218 my ($fdataindex); 219 220 if (($ctcpitem eq "") || ($ctcpreply eq "")) { 221 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_repusage'); 222 return; 223 } 224 225 if (!already_loaded($ctcpitem)) { 226 for (my $index = 0; $index < @fakectcp; ++$index) { 227 if (lc($fakectcp[$index]->{item}) eq $ctcpitem) { 228 $fdataindex = splice(@fakectcp, $index, 1); 229 } elsif ($fdataindex) { 230 save_fakectcplist("$irssidir/$fakectcp_file"); 231 } 232 } 233 } 234 235 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_replaced', $ctcpitem, $ctcpreply); 236 push(@fakectcp, new_fctcp($ctcpitem, $ctcpreply)); 237 save_fakectcplist("$irssidir/$fakectcp_file"); 238} 239 240sub fakectcp { 241 242 my ($cmdoption, $ctcpitem, $ctcpreply) = split (" ", $_[0], 3); 243 244 $ctcpitem = lc($ctcpitem); 245 $cmdoption = lc($cmdoption); 246 247 if ($cmdoption eq "-add") { 248 addfakectcp("$ctcpitem $ctcpreply"); 249 return; 250 } elsif ($cmdoption eq "-del") { 251 delfakectcp("$ctcpitem"); 252 return; 253 } elsif ($cmdoption eq "-help") { 254 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_help', $help); 255 return; 256 } elsif ($cmdoption eq "-replace") { 257 replacefakectcp("$ctcpitem $ctcpreply"); 258 return; 259 } 260 261 if (@fakectcp == 0) { 262 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_empty'); 263 } else { 264 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_info'); 265 266 for (my $n = 0; $n < @fakectcp ; ++$n) { 267 Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'fctcp_print', $n, $fakectcp[$n]->{item}, $fakectcp[$n]->{reply}); 268 } 269 } 270} 271 272load_fakectcplist("$irssidir/$fakectcp_file"); 273 274Irssi::signal_add('default ctcp msg', 'ctcpreply'); 275Irssi::command_bind('fctcp', 'fakectcp'); 276Irssi::command_set_options('fctcp','add del list help replace'); 277Irssi::printformat(MSGLEVEL_CLIENTCRAP, 'loaded', $IRSSI{name}, $VERSION, $IRSSI{authors}); 278