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