line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package AnyEvent::IRC::Server; |
2
|
|
|
|
|
|
|
|
3
|
6
|
|
|
6
|
|
1899416
|
use strict; |
|
6
|
|
|
|
|
17
|
|
|
6
|
|
|
|
|
264
|
|
4
|
6
|
|
|
6
|
|
35
|
use warnings; |
|
6
|
|
|
|
|
13
|
|
|
6
|
|
|
|
|
466
|
|
5
|
|
|
|
|
|
|
our $VERSION = '0.03'; |
6
|
6
|
|
|
6
|
|
34
|
use base qw/Object::Event/; |
|
6
|
|
|
|
|
18
|
|
|
6
|
|
|
|
|
1634
|
|
7
|
6
|
|
|
6
|
|
35733
|
use AnyEvent::Handle; |
|
6
|
|
|
|
|
9138
|
|
|
6
|
|
|
|
|
192
|
|
8
|
6
|
|
|
6
|
|
1198
|
use AnyEvent::Socket; |
|
6
|
|
|
|
|
18995
|
|
|
6
|
|
|
|
|
888
|
|
9
|
6
|
|
|
6
|
|
1228
|
use AnyEvent::IRC::Util qw/parse_irc_msg/; |
|
6
|
|
|
|
|
18407
|
|
|
6
|
|
|
|
|
352
|
|
10
|
6
|
|
|
6
|
|
6065
|
use Sys::Hostname; |
|
6
|
|
|
|
|
8488
|
|
|
6
|
|
|
|
|
384
|
|
11
|
6
|
|
|
6
|
|
1164
|
use POSIX; |
|
6
|
|
|
|
|
7593
|
|
|
6
|
|
|
|
|
60
|
|
12
|
6
|
|
|
6
|
|
31006
|
use Scalar::Util qw/refaddr/; |
|
6
|
|
|
|
|
16
|
|
|
6
|
|
|
|
|
1193
|
|
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
use Class::Accessor::Lite ( |
15
|
6
|
|
|
|
|
56
|
rw => [ |
16
|
|
|
|
|
|
|
qw(host port handles servername channels topics spoofed_nick prepared_cb nick2handle) |
17
|
|
|
|
|
|
|
], |
18
|
6
|
|
|
6
|
|
10108
|
); |
|
6
|
|
|
|
|
7504
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
my $CRLF = "\015\012"; |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
BEGIN { |
23
|
6
|
|
|
6
|
|
892
|
no strict 'refs'; |
|
6
|
|
|
|
|
12
|
|
|
6
|
|
|
|
|
443
|
|
24
|
6
|
|
|
6
|
|
67
|
while (my ($code, $name) = each %AnyEvent::IRC::Util::RFC_NUMCODE_MAP) { |
25
|
846
|
|
|
|
|
4598
|
*{"${name}"} = sub () { $code }; |
|
846
|
|
|
|
|
28587
|
|
|
0
|
|
|
|
|
0
|
|
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
}; |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
sub debugf { |
30
|
109
|
50
|
|
109
|
0
|
259
|
return unless $ENV{AEIS_DEBUG}; |
31
|
0
|
|
|
|
|
0
|
require Data::Dumper; |
32
|
0
|
|
|
|
|
0
|
require Term::ANSIColor; |
33
|
0
|
|
|
|
|
0
|
local $Data::Dumper::Terse=1; |
34
|
0
|
|
|
|
|
0
|
local $Data::Dumper::Indent=0; |
35
|
0
|
|
|
|
|
0
|
my $fmt = shift; |
36
|
0
|
0
|
|
|
|
0
|
my $s = sprintf $fmt, (map { |
|
|
0
|
|
|
|
|
|
37
|
0
|
|
|
|
|
0
|
ref($_) ? ( |
38
|
|
|
|
|
|
|
Data::Dumper::Dumper($_) |
39
|
|
|
|
|
|
|
) : (defined($_) ? $_ : '<>') |
40
|
|
|
|
|
|
|
} @_); |
41
|
0
|
|
|
|
|
0
|
my ($package, $filename, $line) = caller(0); |
42
|
0
|
|
|
|
|
0
|
$s .= " at $filename line $line\n"; |
43
|
0
|
|
|
|
|
0
|
print Term::ANSIColor::colored(["cyan"], $s); |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
|
|
|
|
|
|
sub new { |
47
|
2
|
|
|
2
|
1
|
13933
|
my $class = shift; |
48
|
|
|
|
|
|
|
my $self = $class->SUPER::new( |
49
|
|
|
|
|
|
|
handles => {}, # refaddr($handle) => $handle |
50
|
|
|
|
|
|
|
channels => {}, |
51
|
|
|
|
|
|
|
topics => {}, |
52
|
|
|
|
|
|
|
spoofed_nick => {}, |
53
|
|
|
|
|
|
|
nick2handle => {}, # $nick => $hanldle, |
54
|
|
|
|
|
|
|
welcome => 'Welcome to the my IRC server', |
55
|
|
|
|
|
|
|
servername => hostname(), |
56
|
|
|
|
|
|
|
network => 'AnyEventIRCServer', |
57
|
|
|
|
|
|
|
ctime => POSIX::strftime( '%Y-%m-%d %H:%M:%S', localtime() ), |
58
|
|
|
|
|
|
|
channel_chars => '#&', |
59
|
|
|
|
|
|
|
prepared_cb => sub { |
60
|
0
|
|
|
0
|
|
0
|
my ($self, $host, $port) = @_; |
61
|
0
|
|
|
|
|
0
|
print "$class is ready on : $host:$port\n"; |
62
|
|
|
|
|
|
|
}, |
63
|
2
|
|
|
|
|
17
|
@_, |
64
|
|
|
|
|
|
|
); |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
my $say = sub { |
68
|
33
|
|
|
33
|
|
122
|
my ($handle, $cmd, @args) = @_; |
69
|
33
|
|
|
|
|
90
|
my $msg = mk_msg_ex($self->host, $cmd, $handle->{nick}, @args); |
70
|
33
|
|
|
|
|
68
|
debugf("Sending '%s'", $msg); |
71
|
33
|
|
|
|
|
38
|
$msg .= $CRLF; |
72
|
33
|
|
|
|
|
88
|
$handle->push_write($msg) |
73
|
2
|
|
|
|
|
8339
|
}; |
74
|
|
|
|
|
|
|
my $need_more_params = sub { |
75
|
0
|
|
|
0
|
|
0
|
my ($handle, $cmd) = @_; |
76
|
0
|
|
|
|
|
0
|
$say->($handle, ERR_NEEDMOREPARAMS, $cmd, 'Not enough parameters'); |
77
|
2
|
|
|
|
|
12
|
}; |
78
|
|
|
|
|
|
|
$self->reg_cb( |
79
|
|
|
|
|
|
|
nick => sub { |
80
|
3
|
|
|
3
|
|
50
|
my ($self, $msg, $handle) = @_; |
81
|
3
|
|
|
|
|
4
|
my ($nick) = @{$msg->{params}}; |
|
3
|
|
|
|
|
8
|
|
82
|
3
|
50
|
|
|
|
15
|
unless (defined $nick) { |
83
|
0
|
|
|
|
|
0
|
return $need_more_params->($handle, 'NICK'); |
84
|
|
|
|
|
|
|
} |
85
|
3
|
50
|
|
|
|
12
|
if ($self->nick2handle->{$nick}) { |
86
|
0
|
|
|
|
|
0
|
return $say->($handle, ERR_NICKNAMEINUSE, $nick, 'Nickname already in use'); |
87
|
|
|
|
|
|
|
} |
88
|
3
|
|
|
|
|
21
|
debugf("Set nick: %s", $nick); |
89
|
3
|
|
|
|
|
5
|
$handle->{nick} = $nick; |
90
|
3
|
|
|
|
|
8
|
$self->nick2handle->{$nick} = $handle; |
91
|
|
|
|
|
|
|
# TODO: broadcast to each user |
92
|
|
|
|
|
|
|
}, |
93
|
|
|
|
|
|
|
user => sub { |
94
|
3
|
|
|
3
|
|
47
|
my ($self, $msg, $handle) = @_; |
95
|
3
|
|
|
|
|
4
|
my ($user, $host, $server, $realname) = @{$msg->{params}}; |
|
3
|
|
|
|
|
11
|
|
96
|
|
|
|
|
|
|
# TODO: Note that hostname and servername are normally ignored by the IRC server when the USER command comes from a directly connected client (for security reasons) |
97
|
3
|
|
|
|
|
8
|
$handle->{user} = $user; |
98
|
3
|
|
|
|
|
18
|
$handle->{hostname} = $host; |
99
|
3
|
|
|
|
|
6
|
$handle->{servername} = $server; |
100
|
3
|
|
|
|
|
7
|
$handle->{realname} = $realname; |
101
|
|
|
|
|
|
|
|
102
|
3
|
|
|
|
|
11
|
$say->( $handle, RPL_WELCOME(), $self->{welcome} ); |
103
|
3
|
|
|
|
|
201
|
$say->( $handle, RPL_YOURHOST(), "Your host is @{[ $self->servername ]} [@{[ $self->servername ]}/@{[ $self->port ]}]. @{[ ref $self ]}/$VERSION" ); # 002 |
|
3
|
|
|
|
|
14
|
|
|
3
|
|
|
|
|
27
|
|
|
3
|
|
|
|
|
24
|
|
|
3
|
|
|
|
|
28
|
|
104
|
3
|
|
|
|
|
202
|
$say->( $handle, RPL_CREATED(), "This server was created $self->{ctime}"); |
105
|
3
|
|
|
|
|
153
|
$say->( $handle, RPL_MYINFO(), "@{[ $self->servername ]} @{[ ref $self ]}-$VERSION" ); # 004 |
|
3
|
|
|
|
|
9
|
|
|
3
|
|
|
|
|
36
|
|
106
|
3
|
|
|
|
|
145
|
$say->( $handle, ERR_NOMOTD(), "MOTD File is missing" ); |
107
|
|
|
|
|
|
|
}, |
108
|
|
|
|
|
|
|
'join' => sub { |
109
|
5
|
|
|
5
|
|
75
|
my ($self, $msg, $handle) = @_; |
110
|
5
|
|
|
|
|
7
|
my ($chans) = @{$msg->{params}}; |
|
5
|
|
|
|
|
10
|
|
111
|
5
|
50
|
|
|
|
16
|
unless ($chans) { |
112
|
0
|
|
|
|
|
0
|
return $need_more_params->($handle, 'JOIN'); |
113
|
|
|
|
|
|
|
} |
114
|
5
|
|
|
|
|
17
|
for my $chan ( split /,/, $chans ) { |
115
|
5
|
|
|
|
|
10
|
my $nick = $handle->{nick}; |
116
|
5
|
|
|
|
|
10
|
debugf("%s joined to %s", $nick, $chans); |
117
|
5
|
|
|
|
|
16
|
$self->channels->{$chan}->{handles}->{$nick} = $handle; |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
# server reply |
120
|
5
|
|
50
|
|
|
46
|
$say->( $handle, RPL_TOPIC(), $chan, $self->topics->{$chan} || '' ); |
121
|
5
|
|
|
|
|
239
|
for my $handle (values %{$self->channels->{$chan}->{handles}}) { |
|
5
|
|
|
|
|
15
|
|
122
|
6
|
50
|
|
|
|
74
|
next unless $handle->{nick}; |
123
|
6
|
50
|
|
|
|
17
|
next if $self->spoofed_nick->{$handle->{nick}}; |
124
|
6
|
|
|
|
|
41
|
$say->( $handle, RPL_NAMREPLY(), $chan, $handle->{nick} ); |
125
|
|
|
|
|
|
|
} |
126
|
5
|
|
|
|
|
209
|
$say->( $handle, RPL_ENDOFNAMES(), $chan, 'End of NAMES list.' ); |
127
|
|
|
|
|
|
|
|
128
|
|
|
|
|
|
|
# send join message |
129
|
5
|
|
|
|
|
182
|
my $comment = sprintf '%s!%s@%s', $nick, $nick, $self->servername; |
130
|
|
|
|
|
|
|
# my $comment = sprintf '%s!%s@%s', $nick, $handle->{user}, $handle->{servername}; |
131
|
5
|
|
|
|
|
46
|
my $raw = mk_msg_ex($comment, 'JOIN', $chan) . $CRLF; |
132
|
5
|
|
|
|
|
9
|
for my $handle (values %{$self->channels->{$chan}->{handles}}) { |
|
5
|
|
|
|
|
15
|
|
133
|
6
|
50
|
|
|
|
68
|
next unless $handle->{nick}; |
134
|
6
|
50
|
|
|
|
14
|
next if $self->spoofed_nick->{$handle->{nick}}; |
135
|
6
|
|
|
|
|
51
|
$handle->push_write($raw); |
136
|
|
|
|
|
|
|
} |
137
|
5
|
|
|
|
|
187
|
$self->event('daemon_join' => $nick, $chan); |
138
|
|
|
|
|
|
|
} |
139
|
|
|
|
|
|
|
}, |
140
|
|
|
|
|
|
|
part => sub { |
141
|
0
|
|
|
0
|
|
0
|
my ($self, $msg, $handle) = @_; |
142
|
0
|
|
|
|
|
0
|
my ($chans, $text) = @{$msg->{params}}; |
|
0
|
|
|
|
|
0
|
|
143
|
0
|
0
|
|
|
|
0
|
unless ($chans) { |
144
|
0
|
|
|
|
|
0
|
return $need_more_params->($handle, 'PART'); |
145
|
|
|
|
|
|
|
} |
146
|
0
|
|
|
|
|
0
|
for my $chan ( split /,/, $chans ) { |
147
|
0
|
|
|
|
|
0
|
my $nick = $handle->{nick}; |
148
|
0
|
|
|
|
|
0
|
$self->_intern_part($nick, $chan, $text); |
149
|
0
|
|
|
|
|
0
|
$self->event('daemon_part' => $nick, $chan); |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
}, |
152
|
|
|
|
|
|
|
topic => sub { |
153
|
2
|
|
|
2
|
|
33
|
my ($irc, $msg, $handle) = @_; |
154
|
2
|
|
|
|
|
2
|
my ($chan, $topic) = @{$msg->{params}}; |
|
2
|
|
|
|
|
6
|
|
155
|
2
|
50
|
|
|
|
5
|
unless ($chan) { |
156
|
0
|
|
|
|
|
0
|
return $need_more_params->($handle, 'TOPIC'); |
157
|
|
|
|
|
|
|
} |
158
|
2
|
50
|
|
|
|
4
|
if ($topic) { |
159
|
2
|
|
|
|
|
7
|
$say->( $handle, RPL_TOPIC, $self->topics->{$chan} ); |
160
|
2
|
|
|
|
|
74
|
my $nick = $handle->{nick}; |
161
|
2
|
|
|
|
|
7
|
$self->_intern_topic($nick, $chan, $topic); |
162
|
2
|
|
|
|
|
7
|
$self->event('daemon_topic' => $nick, $chan, $topic); |
163
|
|
|
|
|
|
|
} else { |
164
|
0
|
|
|
|
|
0
|
$say->( $handle, RPL_NOTOPIC, $chan, 'No topic is set' ); |
165
|
|
|
|
|
|
|
} |
166
|
|
|
|
|
|
|
}, |
167
|
|
|
|
|
|
|
'privmsg' => sub { |
168
|
1
|
|
|
1
|
|
18
|
my ($irc, $msg, $handle) = @_; |
169
|
1
|
|
|
|
|
2
|
my ($chan, $text) = @{$msg->{params}}; |
|
1
|
|
|
|
|
4
|
|
170
|
1
|
50
|
|
|
|
4
|
unless ($chan) { |
171
|
0
|
|
|
|
|
0
|
return $need_more_params->($handle, 'PRIVMSG'); |
172
|
|
|
|
|
|
|
} |
173
|
1
|
|
|
|
|
5
|
my $nick = $handle->{nick}; |
174
|
1
|
50
|
|
|
|
5
|
if ($nick eq '*') { |
175
|
0
|
|
|
|
|
0
|
warn 'Nick was not set.'; |
176
|
|
|
|
|
|
|
} |
177
|
1
|
|
|
|
|
5
|
$self->_intern_privmsg($nick, $chan, $text); |
178
|
1
|
|
|
|
|
5
|
$self->event('daemon_privmsg' => $nick, $chan, $text); |
179
|
|
|
|
|
|
|
}, |
180
|
|
|
|
|
|
|
'notice' => sub { |
181
|
0
|
|
|
0
|
|
0
|
my ($irc, $raw, $handle) = @_; |
182
|
0
|
|
|
|
|
0
|
my ($chan, $msg) = @{$raw->{params}}; |
|
0
|
|
|
|
|
0
|
|
183
|
0
|
0
|
|
|
|
0
|
unless ($msg) { |
184
|
0
|
|
|
|
|
0
|
return $need_more_params->($handle, 'NOTICE'); |
185
|
|
|
|
|
|
|
} |
186
|
0
|
|
|
|
|
0
|
my $nick = $handle->{nick}; |
187
|
0
|
|
|
|
|
0
|
$self->_intern_notice($nick, $chan, $msg); |
188
|
0
|
|
|
|
|
0
|
$self->event('daemon_notice' => $nick, $chan, $msg); |
189
|
|
|
|
|
|
|
}, |
190
|
|
|
|
|
|
|
'list' => sub { |
191
|
1
|
|
|
1
|
|
16
|
my ($irc, $raw, $handle) = @_; |
192
|
1
|
|
|
|
|
2
|
my ($chans, $msg) = @{$raw->{params}}; |
|
1
|
|
|
|
|
3
|
|
193
|
1
|
|
|
|
|
5
|
$self->_intern_list($handle, $chans); |
194
|
|
|
|
|
|
|
}, |
195
|
|
|
|
|
|
|
who => sub { |
196
|
0
|
|
|
0
|
|
0
|
my ($irc, $msg, $handle) = @_; |
197
|
0
|
|
|
|
|
0
|
my ($name) = @{$msg->{params}}; |
|
0
|
|
|
|
|
0
|
|
198
|
|
|
|
|
|
|
|
199
|
0
|
0
|
|
|
|
0
|
unless ( $self->channels->{$name} ) { |
200
|
|
|
|
|
|
|
# TODO: ZNC calls '*'. |
201
|
|
|
|
|
|
|
# AEIS should process it. |
202
|
0
|
|
|
|
|
0
|
debugf("The channel is not listed: $name"); |
203
|
0
|
|
|
|
|
0
|
$say->( $handle, RPL_ENDOFWHO(), 'END of /WHO list'); |
204
|
0
|
|
|
|
|
0
|
return; |
205
|
|
|
|
|
|
|
# return $need_more_params->($handle, 'WHO'); # TODO |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
0
|
|
|
|
|
0
|
$say->( $handle, RPL_WHOREPLY(), $name, $handle->{user}, $handle->{hostname}, $handle->{servername}, $handle->{nick},"H:1", $handle->{realname}); |
209
|
0
|
|
|
|
|
0
|
$say->( $handle, RPL_ENDOFWHO(), 'END of /WHO list'); |
210
|
|
|
|
|
|
|
}, |
211
|
|
|
|
|
|
|
ping => sub { |
212
|
0
|
|
|
0
|
|
0
|
my ($irc, $msg, $handle) = @_; |
213
|
0
|
|
|
|
|
0
|
$say->( $handle, 'PONG', $msg->{params}->[0]); |
214
|
|
|
|
|
|
|
}, |
215
|
2
|
|
|
|
|
79
|
); |
216
|
2
|
|
|
|
|
1230
|
return $self; |
217
|
|
|
|
|
|
|
} |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
sub _server_comment { |
220
|
1
|
|
|
1
|
|
2
|
my ($self, $nick) = @_; |
221
|
1
|
|
|
|
|
4
|
return sprintf '%s!~%s@%s', $nick, $nick, $self->servername; |
222
|
|
|
|
|
|
|
} |
223
|
|
|
|
|
|
|
|
224
|
|
|
|
|
|
|
sub _send_chan_msg { |
225
|
4
|
|
|
4
|
|
20
|
my ($self, $nick, $chan, @args) = @_; |
226
|
|
|
|
|
|
|
# send join message |
227
|
4
|
|
|
|
|
11
|
my $handle = $self->channels->{$chan}->{handles}->{$nick}; |
228
|
4
|
|
66
|
|
|
47
|
my $comment = sprintf '%s!%s@%s', $nick, $handle->{user} || $nick, $handle->{servername} || $self->servername; |
|
|
|
33
|
|
|
|
|
229
|
4
|
|
|
|
|
36
|
my $raw = mk_msg_ex($comment, @args); |
230
|
4
|
|
|
|
|
10
|
debugf("_send_chan_msg: %s", $raw); |
231
|
4
|
|
|
|
|
6
|
$raw .= $CRLF; |
232
|
4
|
50
|
|
|
|
13
|
if ($self->is_channel_name($chan)) { |
233
|
4
|
|
|
|
|
6
|
for my $handle (values %{$self->channels->{$chan}->{handles}}) { |
|
4
|
|
|
|
|
11
|
|
234
|
6
|
50
|
|
|
|
108
|
next unless $handle->{nick}; |
235
|
6
|
100
|
|
|
|
24
|
next if $handle->{nick} eq $nick; |
236
|
3
|
50
|
|
|
|
6
|
next if $self->spoofed_nick->{$handle->{nick}}; |
237
|
3
|
|
|
|
|
21
|
$handle->push_write($raw); |
238
|
|
|
|
|
|
|
} |
239
|
|
|
|
|
|
|
} else { |
240
|
|
|
|
|
|
|
# private talk |
241
|
|
|
|
|
|
|
# TODO: TOO SLOW |
242
|
0
|
|
|
|
|
0
|
my $handle = $self->nick2handle->{$chan}; |
243
|
0
|
0
|
|
|
|
0
|
if ($handle) { |
244
|
0
|
|
|
|
|
0
|
$handle->push_write($raw); |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
} |
248
|
|
|
|
|
|
|
|
249
|
|
|
|
|
|
|
sub run { |
250
|
2
|
|
|
2
|
0
|
80
|
my $self = shift; |
251
|
|
|
|
|
|
|
tcp_server $self->{host}, $self->{port}, sub { |
252
|
3
|
|
|
3
|
|
19808
|
my ($fh, $host, $port) = @_; |
253
|
|
|
|
|
|
|
my $handle = AnyEvent::Handle->new( |
254
|
|
|
|
|
|
|
on_error => sub { |
255
|
0
|
|
|
|
|
0
|
my ($handle) = @_; |
256
|
0
|
|
|
|
|
0
|
$self->event('on_error' => $handle); |
257
|
|
|
|
|
|
|
}, |
258
|
|
|
|
|
|
|
on_eof => sub { |
259
|
0
|
|
|
|
|
0
|
my ($handle) = @_; |
260
|
0
|
|
|
|
|
0
|
$self->event('on_eof' => $handle); |
261
|
|
|
|
|
|
|
# TODO: part from each channel |
262
|
0
|
0
|
|
|
|
0
|
if (my $nick = $handle->{nick}) { |
263
|
0
|
|
|
|
|
0
|
delete $self->nick2handle->{$nick}; |
264
|
|
|
|
|
|
|
} |
265
|
0
|
|
|
|
|
0
|
delete $self->handles->{refaddr($handle)}; |
266
|
|
|
|
|
|
|
}, |
267
|
3
|
|
|
|
|
38
|
fh => $fh, |
268
|
|
|
|
|
|
|
); |
269
|
3
|
|
|
|
|
170
|
$handle->{nick} = '*'; |
270
|
|
|
|
|
|
|
$handle->on_read(sub { |
271
|
|
|
|
|
|
|
$handle->push_read(line => sub { |
272
|
17
|
|
|
|
|
615
|
my ($handle, $line, $eol) = @_; |
273
|
17
|
|
|
|
|
57
|
my $msg = parse_irc_msg($line); |
274
|
17
|
|
|
|
|
534
|
$self->handle_msg($msg, $handle); |
275
|
17
|
|
|
|
|
9726
|
}); |
276
|
3
|
|
|
|
|
25
|
}); |
277
|
3
|
|
|
|
|
111
|
$self->handles->{refaddr($handle)} = $handle; |
278
|
2
|
|
|
|
|
29
|
}, $self->prepared_cb(); |
279
|
|
|
|
|
|
|
} |
280
|
|
|
|
|
|
|
|
281
|
|
|
|
|
|
|
sub handle_msg { |
282
|
17
|
|
|
17
|
0
|
28
|
my ($self, $msg, $handle) = @_; |
283
|
17
|
|
|
|
|
33
|
my $event = lc($msg->{command}); |
284
|
17
|
|
|
|
|
34
|
$event =~ s/^(\d+)$/irc_$1/g; |
285
|
17
|
|
|
|
|
85
|
debugf("%s %s", $event, $msg); |
286
|
17
|
|
|
|
|
55
|
$self->event($event, $msg, $handle); |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# ------------------------------------------------------------------------- |
290
|
|
|
|
|
|
|
|
291
|
|
|
|
|
|
|
sub add_spoofed_nick { |
292
|
0
|
|
|
0
|
0
|
0
|
my ($self, $nick) = @_; |
293
|
0
|
|
|
|
|
0
|
$self->{spoofed_nick}->{$nick} = 1; |
294
|
|
|
|
|
|
|
} |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
|
297
|
|
|
|
|
|
|
# ------------------------------------------------------------------------- |
298
|
|
|
|
|
|
|
|
299
|
|
|
|
|
|
|
sub daemon_cmd_join { |
300
|
0
|
|
|
0
|
0
|
0
|
my ($self, $nick, $chan, $msg) = @_; |
301
|
0
|
0
|
|
|
|
0
|
return if $self->channels->{$chan}->{handles}->{$nick}; |
302
|
0
|
|
|
|
|
0
|
$self->add_spoofed_nick($nick); |
303
|
0
|
|
|
|
|
0
|
$self->_intern_join($nick, $chan, $self->nick2handle->{$nick}); |
304
|
|
|
|
|
|
|
} |
305
|
|
|
|
|
|
|
|
306
|
|
|
|
|
|
|
sub daemon_cmd_kick { |
307
|
0
|
|
|
0
|
0
|
0
|
my ($self, $kicker, $chan, $kickee, $comment) = @_; |
308
|
0
|
|
|
|
|
0
|
$self->_intern_kick($kicker, $chan, $kickee, $comment); |
309
|
|
|
|
|
|
|
} |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
sub daemon_cmd_topic { |
312
|
0
|
|
|
0
|
0
|
0
|
my ($self, $nick, $chan, $topic) = @_; |
313
|
0
|
|
|
|
|
0
|
$self->_intern_topic($nick, $chan, $topic); |
314
|
|
|
|
|
|
|
} |
315
|
|
|
|
|
|
|
|
316
|
|
|
|
|
|
|
sub daemon_cmd_part { |
317
|
0
|
|
|
0
|
0
|
0
|
my ($self, $nick, $chan, $msg) = @_; |
318
|
0
|
|
|
|
|
0
|
$self->_intern_part($nick, $chan, $msg); |
319
|
|
|
|
|
|
|
} |
320
|
|
|
|
|
|
|
|
321
|
|
|
|
|
|
|
sub daemon_cmd_privmsg { |
322
|
1
|
|
|
1
|
0
|
1224
|
my ($self, $nick, $chan, $msg) = @_; |
323
|
1
|
|
|
|
|
5
|
$self->_intern_privmsg($nick, $chan, $msg); |
324
|
|
|
|
|
|
|
} |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
sub daemon_cmd_notice { |
327
|
0
|
|
|
0
|
0
|
0
|
my ($self, $nick, $chan, $msg) = @_; |
328
|
0
|
|
|
|
|
0
|
debugf('%s', [$nick, $chan, $msg]); |
329
|
0
|
|
|
|
|
0
|
$self->_intern_notice($nick, $chan, $msg); |
330
|
|
|
|
|
|
|
} |
331
|
|
|
|
|
|
|
|
332
|
|
|
|
|
|
|
# ------------------------------------------------------------------------- |
333
|
|
|
|
|
|
|
|
334
|
|
|
|
|
|
|
sub _intern_list { |
335
|
1
|
|
|
1
|
|
2
|
my ($self, $handle, $chans) = @_; |
336
|
|
|
|
|
|
|
|
337
|
1
|
|
|
|
|
2
|
my $nick = $handle->{nick}; |
338
|
1
|
|
|
|
|
4
|
my $comment = $self->_server_comment($nick); |
339
|
|
|
|
|
|
|
my $send = sub { |
340
|
5
|
|
|
5
|
|
43
|
my $raw = mk_msg_ex($comment, @_) . $CRLF; |
341
|
5
|
|
|
|
|
16
|
$handle->push_write($raw); |
342
|
1
|
|
|
|
|
11
|
}; |
343
|
|
|
|
|
|
|
my $send_rpl_list = sub { |
344
|
3
|
|
|
3
|
|
5
|
my $chan = shift; |
345
|
3
|
|
100
|
|
|
4
|
$send->(RPL_LIST, $nick, $chan, scalar keys %{$self->channels->{$chan}->{handles}}, ':'.($self->topics->{$chan} || '')); |
|
3
|
|
|
|
|
8
|
|
346
|
1
|
|
|
|
|
6
|
}; |
347
|
1
|
|
|
|
|
4
|
$send->(RPL_LISTSTART, $nick, 'Channel', ':Users', 'Name'); |
348
|
1
|
50
|
|
|
|
39
|
if ($chans) { |
349
|
0
|
|
|
|
|
0
|
for my $chan (split /,/, $chans) { |
350
|
0
|
0
|
|
|
|
0
|
if ($self->channels->{$chan}) { |
351
|
0
|
|
|
|
|
0
|
$send_rpl_list->($chan); |
352
|
|
|
|
|
|
|
} |
353
|
|
|
|
|
|
|
} |
354
|
|
|
|
|
|
|
} else { |
355
|
1
|
|
|
|
|
4
|
my $channels = $self->channels; |
356
|
1
|
|
|
|
|
11
|
while (my ($chan, $val) = each %$channels) { |
357
|
3
|
|
|
|
|
71
|
$send_rpl_list->($chan); |
358
|
|
|
|
|
|
|
} |
359
|
|
|
|
|
|
|
} |
360
|
1
|
|
|
|
|
35
|
$send->(RPL_LISTEND, $nick, 'End of /LIST'); |
361
|
|
|
|
|
|
|
} |
362
|
|
|
|
|
|
|
|
363
|
|
|
|
|
|
|
sub _intern_privmsg { |
364
|
2
|
|
|
2
|
|
6
|
my ($self, $nick, $chan, $text) = @_; |
365
|
2
|
|
|
|
|
7
|
$self->_send_chan_msg($nick, $chan, 'PRIVMSG', $chan, $text); |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
|
368
|
|
|
|
|
|
|
sub _intern_notice { |
369
|
0
|
|
|
0
|
|
0
|
my ($self, $nick, $chan, $text) = @_; |
370
|
0
|
|
|
|
|
0
|
debugf('%s', [$nick, $chan, $text]); |
371
|
0
|
|
|
|
|
0
|
$self->_send_chan_msg($nick, $chan, 'NOTICE', $chan, $text); |
372
|
|
|
|
|
|
|
} |
373
|
|
|
|
|
|
|
|
374
|
|
|
|
|
|
|
sub _intern_topic { |
375
|
2
|
|
|
2
|
|
5
|
my ($self, $nick, $chan, $topic) = @_; |
376
|
2
|
|
|
|
|
6
|
$self->topics->{$chan} = $topic; |
377
|
2
|
|
|
|
|
14
|
$self->_send_chan_msg($nick, $chan, 'TOPIC', $chan, $self->topics->{$chan}); |
378
|
|
|
|
|
|
|
} |
379
|
|
|
|
|
|
|
|
380
|
|
|
|
|
|
|
sub _intern_join { |
381
|
0
|
|
|
0
|
|
0
|
my ($self, $nick, $chan, $handle) = @_; |
382
|
0
|
|
|
|
|
0
|
$self->channels->{$chan}->{handles}->{$nick} = $handle; |
383
|
0
|
|
|
|
|
0
|
$self->_send_chan_msg($nick, $chan, 'JOIN', $chan); |
384
|
|
|
|
|
|
|
} |
385
|
|
|
|
|
|
|
|
386
|
|
|
|
|
|
|
sub _intern_part { |
387
|
0
|
|
|
0
|
|
0
|
my ($self, $nick, $chan, $msg) = @_; |
388
|
0
|
|
0
|
|
|
0
|
$msg ||= $nick; |
389
|
|
|
|
|
|
|
|
390
|
|
|
|
|
|
|
# send part message |
391
|
0
|
|
|
|
|
0
|
$self->_send_chan_msg($nick, $chan, 'PART', $chan, $msg); |
392
|
0
|
|
|
|
|
0
|
delete $self->channels->{$chan}->{handles}->{$nick}; |
393
|
|
|
|
|
|
|
} |
394
|
|
|
|
|
|
|
|
395
|
|
|
|
|
|
|
# /KICK [] |
396
|
|
|
|
|
|
|
# use this line in /kick: $self->event('daemon_kick' => $kicker, $chan, $kickee, $comment); |
397
|
|
|
|
|
|
|
sub _intern_kick { |
398
|
0
|
|
|
0
|
|
0
|
my ($self, $kicker, $chan, $kickee, $comment) = @_; |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
# TODO: implement |
401
|
|
|
|
|
|
|
# TODO: oper check |
402
|
0
|
|
|
|
|
0
|
my $handle = $self->channels->{$chan}->{handles}->{$kicker}; |
403
|
0
|
|
0
|
|
|
0
|
my $cmt_irc = sprintf '%s!%s@%s', $kicker, $handle->{user} || $kicker , $handle->{servername} || $self->servername; |
|
|
|
0
|
|
|
|
|
404
|
0
|
|
|
|
|
0
|
my $raw = mk_msg_ex($cmt_irc, 'KICK', $chan, $kickee, $comment) . $CRLF; |
405
|
0
|
|
|
|
|
0
|
for my $handle (values %{$self->channels->{$chan}->{handles}}) { |
|
0
|
|
|
|
|
0
|
|
406
|
0
|
|
|
|
|
0
|
$handle->push_write($raw); |
407
|
|
|
|
|
|
|
} |
408
|
0
|
|
|
|
|
0
|
delete $self->channels->{$chan}->{handles}->{$kickee}; |
409
|
|
|
|
|
|
|
} |
410
|
|
|
|
|
|
|
|
411
|
|
|
|
|
|
|
# ------------------------------------------------------------------------- |
412
|
|
|
|
|
|
|
|
413
|
|
|
|
|
|
|
sub is_channel_name { |
414
|
4
|
|
|
4
|
0
|
7
|
my ( $self, $string ) = @_; |
415
|
4
|
|
|
|
|
10
|
my $cchrs = $self->{channel_chars}; |
416
|
4
|
|
|
|
|
81
|
$string =~ /^([\Q$cchrs\E]+)(.+)$/; |
417
|
|
|
|
|
|
|
} |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
sub mk_msg_ex { |
420
|
47
|
|
|
47
|
0
|
244
|
my ( $prefix, $command, @params ) = @_; |
421
|
47
|
|
|
|
|
55
|
my $msg = ""; |
422
|
|
|
|
|
|
|
|
423
|
47
|
100
|
|
|
|
113
|
$msg .= defined $prefix ? ":$prefix " : ""; |
424
|
47
|
|
|
|
|
73
|
$msg .= "$command"; |
425
|
|
|
|
|
|
|
|
426
|
47
|
|
|
|
|
42
|
my $trail; |
427
|
47
|
|
|
|
|
89
|
debugf("%s", \@params); |
428
|
47
|
100
|
|
|
|
106
|
if ( @params >= 2 ) { |
429
|
42
|
|
|
|
|
51
|
$trail = pop @params; |
430
|
|
|
|
|
|
|
} |
431
|
|
|
|
|
|
|
|
432
|
|
|
|
|
|
|
# FIXME: params must be counted, and if > 13 they have to be |
433
|
|
|
|
|
|
|
# concationated with $trail |
434
|
47
|
|
|
|
|
61
|
map { $msg .= " $_" } @params; |
|
71
|
|
|
|
|
145
|
|
435
|
|
|
|
|
|
|
|
436
|
47
|
100
|
|
|
|
108
|
$msg .= defined $trail ? " :$trail" : ""; |
437
|
|
|
|
|
|
|
|
438
|
47
|
|
|
|
|
107
|
return $msg; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
1; |
442
|
|
|
|
|
|
|
__END__ |