Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 294 lines (235 sloc) 9.068 kB
05bc682 @symkat Inital Git Version
authored
1 use Irssi;
2 use vars qw/$VERSION %IRSSI/;
f7f8a6f @symkat Added patch by Mantas Mikulėnas
authored
3 use File::Spec;
05bc682 @symkat Inital Git Version
authored
4 use DBI;
5 use POSIX qw/ strftime /;
6
7 # Requires:
8 # DBI
9 # DBD::SQLite3
10
7c55798 @symkat * Added channel sync event handling to replace who on join
authored
11 $VERSION = '0.40';
05bc682 @symkat Inital Git Version
authored
12 %IRSSI = (
13 authors => 'SymKat',
14 contact => 'symkat@symkat.com',
15 name => "stalker",
16 decsription => 'Records and correlates nick!user@host information',
17 license => "BSD",
18 url => "http://github.com/symkat/stalker",
19 changed => "2010-10-06",
20 changes => "See Change Log",
21 );
22
23 # Bindings
24 Irssi::signal_add_last( 'event 311', \&whois_request );
25 Irssi::signal_add( 'message join', \&nick_joined );
26 Irssi::signal_add( 'nicklist changed', \&nick_changed_channel );
7c55798 @symkat * Added channel sync event handling to replace who on join
authored
27 Irssi::signal_add( 'channel sync', \&channel_sync );
05bc682 @symkat Inital Git Version
authored
28
29 Irssi::command_bind( 'host_lookup', \&host_request );
30 Irssi::command_bind( 'nick_lookup', \&nick_request );
31
32 Irssi::theme_register([$IRSSI{'name'} => '{whois stalker %|$1}']);
33
34 # Settings
f7f8a6f @symkat Added patch by Mantas Mikulėnas
authored
35 Irssi::settings_add_str( 'Stalker', $IRSSI{name} . "_db_path", "nicks.db" );
05bc682 @symkat Inital Git Version
authored
36 Irssi::settings_add_str( 'Stalker', $IRSSI{name} . "_max_recursion", 20 );
37 Irssi::settings_add_str( 'Stalker', $IRSSI{name} . "_guest_nick_regex", "/^guest.*/i" );
f7f8a6f @symkat Added patch by Mantas Mikulėnas
authored
38 Irssi::settings_add_str( 'Stalker', $IRSSI{name} . "_debug_log_file", "stalker.log" );
05bc682 @symkat Inital Git Version
authored
39
40 Irssi::settings_add_bool( 'Stalker', $IRSSI{name} . "_verbose", 0 );
41 Irssi::settings_add_bool( 'Stalker', $IRSSI{name} . "_debug", 0 );
42 Irssi::settings_add_bool( 'Stalker', $IRSSI{name} . "_recursive_search", 1 );
43 Irssi::settings_add_bool( 'Stalker', $IRSSI{name} . "_search_this_network_only", 0 );
44 Irssi::settings_add_bool( 'Stalker', $IRSSI{name} . "_ignore_guest_nicks", 1 );
45 Irssi::settings_add_bool( 'Stalker', $IRSSI{name} . "_debug_log", 0 );
46 my $count;
47 my %data;
48 my $str;
49
50 # Database
51
52 my $db = Irssi::settings_get_str($IRSSI{name} . '_db_path');
33468f1 @symkat Patch to the Patch
authored
53 if ( ! File::Spec->file_name_is_absolute($db) ) {
f7f8a6f @symkat Added patch by Mantas Mikulėnas
authored
54 $db = File::Spec->catfile( Irssi::get_irssi_dir(), $db );
55 }
05bc682 @symkat Inital Git Version
authored
56
57 stat_database( $db );
58
59 my $DBH = DBI->connect(
60 'dbi:SQLite:dbname='.$db, "", "",
61 {
62 RaiseError => 1,
63 AutoCommit => 1,
64 }
65 ) or die "Failed to connect to database $db: " . $DBI::errstr;
66
67
68 # IRSSI Routines
69
70 sub whois_request {
71 my ( $server, $data, $server_name ) = @_;
72 my ( $me, $n, $u, $h ) = split(" ", $data );
73
74 $server->printformat($n,MSGLEVEL_CRAP,$IRSSI{'name'},$n,
75 join( ", ", (get_records('host', $h, $server->{address}))) . "." );
76 }
77
78 sub host_request {
79 windowPrint( join( ", ", (get_records('host', $_[0], $_[1]->{address}))) . ".");
80 }
81
82 sub nick_request {
83 windowPrint( join( ", ", (get_records('nick', $_[0], $_[1]->{address}))) . ".");
84 }
85
86 # Record Adding Functions
87 sub nick_joined {
88 add_record($_[2], (split('@', $_[3]), $_[0]->{address}));
89 }
90
91 sub nick_changed_channel {
92 add_record( $_[1]->{nick}, (split( '@', $_[1]->{host} )), $_[0]->{server}->{address} );
93 }
94
7c55798 @symkat * Added channel sync event handling to replace who on join
authored
95 sub channel_sync {
96 my ( $channel ) = @_;
97
98 my $serv = $channel->{server}->{address};
99
100 for my $nick ( $channel->nicks() ) {
b87cbc4 @symkat Added a check to ensure that CHANNEL_REC->nicks() gets ->{host},
authored
101 last if $nick->{host} eq ''; # Sometimes channel sync doesn't give us this...
7c55798 @symkat * Added channel sync event handling to replace who on join
authored
102 add_record( $nick->{nick}, ( split( '@', $nick->{host} ) ), $serv );
103 }
05bc682 @symkat Inital Git Version
authored
104 }
105
106
107 # Automatic Database Creation And Checking
108 sub stat_database {
109 my ( $db_file ) = @_;
110 my $do = 0;
111
112 if ( ! -e $db_file ) {
113 open my $fh, '>', $db_file
114 or die "Cannot create database file. Abort.";
115 close $fh;
116 $do = 1;
117 }
118 my $DBH = DBI->connect(
119 'dbi:SQLite:dbname='.$db_file, "", "",
120 {
121 RaiseError => 1,
122 AutoCommit => 1,
123 }
124 );
125
126 create_database( $db_file, $DBH ) if $do;
127
128 my $sth = $DBH->prepare( "SELECT nick from records WHERE serv = ?" );
129 $sth->execute( 'script-test-string' );
130 my $sane = $sth->fetchrow_array;
131
132 create_database( $db_file, $DBH ) if $sane == undef;
133 }
134
135 sub create_database {
136 my ( $db_file, $DBH ) = @_;
137
138 my $query = "CREATE TABLE records (nick TEXT NOT NULL," .
139 "user TEXT NOT NULL, host TEXT NOT NULL, serv TEXT NOT NULL)";
140
141 $DBH->do( "DROP TABLE IF EXISTS records" );
142 $DBH->do( $query );
143 my $sth = $DBH->prepare( "INSERT INTO records (nick, user, host, serv) VALUES( ?, ?, ?, ? )" );
144 $sth->execute( 1, 1, 1, 'script-test-string' );
145 }
146
147 # Other Routines
148
149 sub add_record {
150 my ( $nick, $user, $host, $serv ) = @_;
151
152 # Check if we already have this record.
153 my $q = "SELECT nick FROM records WHERE nick = ? AND user = ? AND host = ? AND serv = ?";
154 my $sth = $DBH->prepare( $q );
155 $sth->execute( $nick, $user, $host, $serv );
156 my $result = $sth->fetchrow_hashref;
157
158 if ( $result->{nick} eq $nick ) {
159 debugPrint( "info", "Record for $nick skipped - already exists." );
160 return 1;
161 }
162
163 debugPrint( "info", "Adding to DB: nick = $nick, user = $user, host = $host, serv = $serv" );
164
165 # We don't have the record, add it.
166 $sth = $DBH->prepare
167 ("INSERT INTO records (nick,user,host,serv) VALUES( ?, ?, ?, ? )" );
168 eval { $sth->execute( $nick, $user, $host, $serv ) };
169 if ($@) {
170 debugPrint( "crit", "Failed to process record, database said: $@" );
171 }
172
173 debugPrint( "info", "Added record for $nick!$user\@$host to $serv" );
174 }
175
176 sub get_records {
177 my ( $type, $query, $serv, @return ) = @_;
178
179 $count = 0; %data = ( );
180 my %data = _r_search( $serv, $type, $query );
181 for my $k ( keys %data ) {
182 debugPrint( "info", "$type query for records on $query from server $serv returned: $k" );
183 push @return, $k if $data{$k} eq 'nick';
184 }
185 return @return;
186 }
187
188 sub _r_search {
189 my ( $serv, $type, @input ) = @_;
190 return %data if $count > 1000;
191 return %data if $count > Irssi::settings_get_str($IRSSI{name} . "_max_recursion");
192 return %data if $count == 2 and ! Irssi::settings_get_bool( $IRSSI{name} . "_recursive_search" );
193
194 debugPrint( "info", "Recursion Level: $count" );
195
196 if ( $type eq 'nick' ) {
197 $count++;
198 for my $nick ( @input ) {
199 next if exists $data{$nick};
200 $data{$nick} = 'nick';
201 my @hosts = _get_hosts_from_nick( $nick, $serv );
202 _r_search( $serv, 'host', @hosts );
203 }
204 } elsif ( $type eq 'host' ) {
205 $count++;
206 for my $host ( @input ) {
207 next if exists $data{$host};
208 $data{$host} = 'host';
209 my @nicks = _get_nicks_from_host( $host, $serv );
492cead * Should be space before "from host..."
Rizla Razla authored
210 verbosePrint( "Got nicks: " . join( ", ", @nicks ) . " from host $host" );
05bc682 @symkat Inital Git Version
authored
211 _r_search( $serv, 'nick', @nicks );
212 }
213 }
214
215 return %data;
216 }
217
218 sub _get_hosts_from_nick {
219 my ( $nick, $serv, @return ) = @_;
220
221 my $sth;
222 if ( Irssi::settings_get_bool( $IRSSI{name} . "_search_this_network_only" ) ){
223 $sth = $DBH->prepare( "select host from records where nick = ? and serv = ?" );
224 $sth->execute( $nick, $serv );
225 } else {
226 $sth = $DBH->prepare( "select host from records where nick = ?" );
227 $sth->execute( $nick );
228 }
229
230 while ( my $row = $sth->fetchrow_hashref ) {
231 push @return, $row->{host};
232 }
233 return @return;
234 }
235
236 sub _get_nicks_from_host {
237 my ( $host, $serv, @return ) = @_;
238
239 my $sth;
240 if ( Irssi::settings_get_bool( $IRSSI{name} . "_search_this_network_only" ) ){
241 $sth = $DBH->prepare( "select nick from records where host = ? and serv = ?" );
242 $sth->execute( $host, $serv );
243 } else {
244 $sth = $DBH->prepare( "select nick from records where host = ?" );
245 $sth->execute( $host );
246 }
247
248 while ( my $row = $sth->fetchrow_hashref ) {
249 if ( Irssi::settings_get_bool($IRSSI{name} . "_ignore_guest_nicks") ) {
250 my $regex = Irssi::settings_get_str( $IRSSI{name} . "_guest_nick_regex" );
251 next if $row->{nick} =~ m/$regex/i;
252 }
253 push @return, $row->{nick};
254 }
255 return @return;
256 }
257
258 # Handle printing.
259 sub debugPrint {
260 # Short cut - instead of two debug statements thoughout the code,
261 # we'll send all debugPrint's to the debugLog function as well
262
263 windowPrint( $IRSSI{name} . " Debug: " . $_[1] )
264 if Irssi::settings_get_bool($IRSSI{name} . "_debug");
265 debugLog( $_[0], $_[1] );
266 }
267
268 sub verbosePrint {
269 windowPrint( $IRSSI{name} . " Verbose: " . $_[0] )
270 if Irssi::settings_get_bool($IRSSI{name} . "_verbose");
271 }
272
273 sub debugLog {
274 my ( $lvl, $msg ) = @_;
275 return unless Irssi::settings_get_bool($IRSSI{name} . "_debug_log" );
276 my $now = strftime( "[%D %H:%M:%S]", localtime );
277
f7f8a6f @symkat Added patch by Mantas Mikulėnas
authored
278 my $logpath = Irssi::settings_get_str( $IRSSI{name} . "_debug_log_file" );
33468f1 @symkat Patch to the Patch
authored
279 if ( ! File::Spec->file_name_is_absolute($logpath) ) {
f7f8a6f @symkat Added patch by Mantas Mikulėnas
authored
280 $logpath = File::Spec->catfile( Irssi::get_irssi_dir(), $logpath );
281 }
282
283 open my $fh, ">>", $logpath
05bc682 @symkat Inital Git Version
authored
284 or die "Fatal error: Cannot open my logfile at " . $IRSSI{name} . "_debug_log_file for writing: $!";
285 print $fh "[$lvl] $now $msg\n";
286 close $fh;
287 }
288
289 sub windowPrint {
290 Irssi::active_win()->print( $_[0] );
291 }
292
293 windowPrint( "Loaded $IRSSI{'name'}" );
Something went wrong with that request. Please try again.