html/joininfo.pl


   1 ###############################################################################
   2 #
   3 # Shows WHOIS: info including realname and channel names on joins to 
   4 # channels.
   5 # 
   6 # This script is based on the autorealname script, and shares a little
   7 # code and many ideas with that script. I use the same globals as they do,
   8 # but with totally different fields because their structure was not really
   9 # easy to adapt to a situation where more info is used on one query.
  10 #
  11 # Rewrote all that code, except for parts of request_whois and some init code
  12 #
  13 # I would like to thank Timo 'cras' Sirainen and Bastian Blank for writing
  14 # the autorealname script. It was a good example.
  15 #
  16 # The script contains very simple flood protection in the form that it will
  17 # not allow for more then $max_queued_requests per server at one time to be
  18 # running. It tries to be smart about netsplits, so this should be okay.
  19 # We have a 5-second timeout to make sure we really don't flood, ans also to
  20 # make sure that we don't wait indefinitely for answers that won't come.
  21 #
  22 # Themes:
  23 #   You can change the way the WHOIS messages look using the /format command,
  24 #   For example:
  25 #   /FORMAT ji_whois_success %GWHOIS:%n {channick_hilight $0} \
  26 #           is "{hilight $1}"%n on {channel $2} 
  27 #
  28 #   Will add a green WHOIS: to the line to make it stand out, save your
  29 #   formatting in irssi using '/SAVE -formats'
  30 #
  31 #   Add 'server: "{hilight $3}"' to the format string to also print the
  32 #   server name (Thanks to Svein Skogen for suggesting this)
  33 #
  34 #   Add 'flags: "{hilight $4}"' to the format string to also print 
  35 #   some additional flags for the user. These flags are tailored for
  36 #   some unknown irc network but also work quite well on IRCNet and EFNet
  37 #   after the 'idle' modifications I added to them. Thanks to
  38 #   Francesco Rolando for providing me with the initial patch.
  39 #
  40 # Commands (/JOININFO ...)
  41 #   INFO  -  Show info on and contents of the current cache of this script
  42 #   GC    -  Manually run the garbage collector once
  43 #   FORCE -  Fake join of a nick to a chan (/JOININFO FORCE ichiban) use with
  44 #            care. Useful for testing theme changes, timeouts and the garbage
  45 #            collector on a quiet day or network. Will ignore your own nick.
  46 #   HELP  -  Shows help
  47 # 
  48 # Settings
  49 #   /SET whois_expire_time       # time to expire one saves record
  50 #                                # until this age has been reched no
  51 #                                # new WHOISs will be put on the server
  52 #
  53 #   /SET whois_max_requests      # max concurrent requests per server
  54 #                                # flood protection, keep low
  55 #
  56 #   /SET whois_timeout_ms        # timeout after which a whois is lost (ms)
  57 #                                # (default: 5000)
  58 #
  59 #   /SET whois_gc_interval_ms    # run gc ever x MS (default: 300000)
  60 #                                # Requires script reload when changed.
  61 #
  62 #   /SET whois_debug             # 0 = show no debug info, 1 = debug info
  63 #
  64 #   /SET whois_printing_level    # Level at which all non-debug output is
  65 #                                # printed, influences logging and IGNORE
  66 #                                # (default: JOINS)
  67 #
  68 # ChangeLog:
  69 # - Tue Jul 15 2003, pbijdens
  70 #   Initial release version 0.5.1
  71 # - Thu Jul 17 2003, pbijdens
  72 #   Version 0.5.2
  73 #   Added garbage collection for the stored info.
  74 #   Added /AWINFO and /AWGC commands to show info and to run the garbage
  75 #   collector manually respectively
  76 #   Added timeout for the putserv WHOIS making sure we do not record too many
  77 #   jobs as BUSY.
  78 # - Thu Jul 17 2003, pbijdens
  79 #   Version 0.5.3
  80 #   Added settings (whois_...) to the irssi config so there is no need to
  81 #   modify the script when changing them
  82 # - Thu Jul 17 2003, pbijdens
  83 #   Version 0.5.5
  84 #   Making sure the settings are reloaded when they are changed. Added a
  85 #   signal handler for that
  86 # - Thu Jul 17 2003, pbijdens
  87 #   Version 0.6.0
  88 #   Added setting for whois_debug
  89 #   Added theme support
  90 #   Bugfix for servers sending 401 without 318 no need to wait for
  91 #   timeout anymore on those
  92 #   Added configurable printing level for the realname+channel messages.
  93 #   use /SET whois_printing_level
  94 #   Added /AWFORCE command (see above)
  95 # - Mon Jul 28 2003, pbijdens
  96 #   Version 0.6.1
  97 #   Various updates and bug fixes
  98 #   Changed awforce command to strip spaces
  99 # - Wed Aug 13 2003, pbijdens
 100 #   Version 0.7.0
 101 #   Fixed typo in comment line
 102 #   Changed /AW* commands to be /JOININFO <subcommand> and added a
 103 #   /JOININFO HELP command. Renamed some subs to make their purpose
 104 #   more clear.
 105 # - Wed Feb 2 2004, pbijdens
 106 #   Added features for filtering channels from the list, and adding
 107 #   support for hilighting channels in colors.
 108 # - Mon Mar 8 2004, pbijdens
 109 #   Fixed bug where also on SILCNET the WHOIS queries would be run, now
 110 #   this service is restricted to IRC networks. Thanks to Tony den Haan
 111 #   for supplying this patch.
 112 # - Mon Mar 8 2004, pbijdens
 113 #   Added support for printing the servername also in the output for those
 114 #   who want to see it. Thanks to Svein Skogen for suggesting this and
 115 #   sending me a patch.
 116 #   NOTE: Requires you to add {hilight $3} to your format string manually.
 117 #   By default the information is not diplayed.
 118 # - Mon Mar 8 2004, pbijdens
 119 #   Added support for additional flags to the WHOIS output. This is stuff
 120 #   like IrcOP, Away, Idle and more. Thanks to Francesco Rolando for
 121 #   providing the additional patch, which I modified.
 122 #   NOTE: Requires you to add {hilight $4} to your format string manually.
 123 #   By default the information is not diplayed.
 124 # - Tue Mar 1 2005, pbijdens
 125 #   Updated the script for compliance with a wider range of servers,
 126 #   and removed some functionality that generally did not work, or break
 127 #   on some servers. Been runing on 4 networks now with these patches for
 128 #   many months, declaring stable and releasing 1.0.
 129 #
 130 ################################################################################
 131 
 132 use Irssi 20011207;
 133 use strict;
 134 use vars qw($VERSION %IRSSI); 
 135 use integer;
 136 
 137 ################################################################################
 138 
 139 $VERSION = "1.0.0";
 140 %IRSSI = (
 141     authors => "Pieter-Bas IJdens",
 142     contact => "irssi-scripts\@nospam.mi4.org.uk",
 143     name    => "joininfo",
 144     description => "Reports WHOIS information and channel list for those who join a channel",
 145     license => "GPLv2 or later",
 146     url     => "http://pieter-bas.ijdens.com/irssi/",
 147     changed => "2005-03-10"
 148 );
 149 
 150 ################################################################################
 151 
 152 # Note that all settings below can and should be changed with /SET, see
 153 # /joininfo help or /set whois
 154 
 155 # The maximum acceeptable age for a cached whois record is 60 seconds
 156 # after this amount of time the cache record is discareded
 157 my $whois_maxage = 60;
 158 
 159 # The maximum number of requests queued at a time, if the queue reaches
 160 # a lrger size, ignore new requets until we have space left. This could
 161 # happen in a netjoin preceded by a very long netsplit 
 162 my $max_queued_requests = 7;
 163 
 164 # Timeout after which a whois request is assumed not having been answered
 165 # by the server. In milliseconds
 166 my $whois_timeout = 5000;
 167 
 168 # Interval for the times at which GC takes place automatically. In milliseconds
 169 my $whois_gc_interval = 300000;
 170 
 171 # Debug poutput on or off
 172 my $whois_debug = 0;
 173 
 174 # Output level (the whois_printing_level_n is the numeric information for the
 175 # output level)
 176 my $whois_printing_level = "JOINS";
 177 my $whois_printing_level_n;
 178 
 179 ################################################################################
 180 
 181 # Cached records per server, plus information about the amount of queued
 182 # reuests
 183 my %servers;
 184 
 185 ################################################################################
 186 
 187 # Registers the theme messages with irssi so they can be changed later by the
 188 # user using the /FORMAT command
 189 sub register_messages
 190 {
 191     Irssi::theme_register([
 192         'ji_whois_success',
 193             '{channick_hilight $0} is "{hilight $1}"%n on {channel $2}',
 194         'ji_whois_list_header',
 195             'Server: {hilight $0} ($1 pending)', 
 196         'ji_whois_list_nick',
 197             '{channick_hilight $0} is "{hilight $1}"%n on {channel $2}', 
 198         'ji_whois_list_status',
 199             'Status: $0; Record age: $1s; Server tag: $2'
 200     ]);
 201 }
 202 
 203 ################################################################################
 204 
 205 # Register the settings we use, and specify a DEFAULT for when Irssi
 206 # did not have them saved yet. Allows users to use /SET later.
 207 sub register_settings
 208 {
 209     Irssi::settings_add_int(
 210         "joininfo",
 211         "whois_expire_time",
 212         $whois_maxage
 213     );
 214     Irssi::settings_add_int(
 215         "joininfo",
 216         "whois_max_requests",
 217         $max_queued_requests
 218     );
 219     Irssi::settings_add_int(
 220         "joininfo",
 221         "whois_timeout_ms",
 222         $whois_timeout
 223     );
 224     Irssi::settings_add_int(
 225         "joininfo",
 226         "whois_gc_interval_ms",
 227         $whois_gc_interval
 228     );
 229     Irssi::settings_add_int(
 230         "joininfo",
 231         "whois_debug",
 232         $whois_debug
 233     );
 234     Irssi::settings_add_str(
 235         "joininfo",
 236         "whois_printing_level",
 237         $whois_printing_level
 238     );
 239 }
 240 
 241 ################################################################################
 242 
 243 # Now (re-)read the settings, those saved in the config will be returned,
 244 # unless not present in which case the default will be returned
 245 # This function is called once on script start, and later is run as an
 246 # event handler when irssi notifies us of a change in settings.
 247 sub load_settings
 248 {
 249     $whois_maxage = Irssi::settings_get_int("whois_expire_time");
 250     $max_queued_requests = Irssi::settings_get_int("whois_max_requests");
 251     $whois_timeout = Irssi::settings_get_int("whois_timeout_ms");
 252     $whois_gc_interval = Irssi::settings_get_int("whois_gc_interval_ms");
 253     $whois_debug = Irssi::settings_get_int("whois_debug");
 254     $whois_printing_level = Irssi::settings_get_str("whois_printing_level");
 255 
 256     $whois_printing_level = uc($whois_printing_level);
 257     $whois_printing_level =~ s/[^A-Z]//gi;
 258 
 259     my($definedlvl);
 260     eval("\$definedlvl = defined(MSGLEVEL_" . $whois_printing_level. ");");
 261 
 262     if (!$definedlvl)
 263     {
 264         Irssi::print(
 265             "%RJOININFO:%n illegal /set whois_printing_level, see /help levels".
 266             " for more informations. Assuming JOINS in stead of ".
 267             "\"$whois_printing_level\"."
 268         );
 269         $whois_printing_level = "JOINS";
 270         $whois_printing_level_n = MSGLEVEL_JOINS;
 271         return;
 272     }
 273 
 274     eval("\$whois_printing_level_n = MSGLEVEL_" . $whois_printing_level . ";");
 275 
 276     if ($whois_printing_level_n == 0)
 277     {
 278         Irssi::print(
 279             "%RJOININFO:%n illegal /set whois_printing_level, see /help levels".
 280             " for more informations. Assuming JOINS in stead of ".
 281             "\"$whois_printing_level\"."
 282         );
 283         $whois_printing_level = "JOINS";
 284         $whois_printing_level_n = MSGLEVEL_JOINS;
 285         return;
 286     }
 287 }
 288 
 289 ################################################################################
 290 
 291 # We keep records of all nicks that ever joined a channel in our memory,
 292 # without ever freeing them up. This can get quite large over time, therefore
 293 # evere once in a while we go out and remove the garbage
 294 #
 295 # Now this function also corrects the pending counter in case strange things
 296 # happen on strange nets
 297 sub garbage_collector
 298 {
 299     my($runtime) = time();
 300 
 301     foreach my $tag (keys(%servers))
 302     {
 303         my($busy) = 0;
 304         my($rec) = $servers{$tag};
 305 
 306         foreach my $nick (keys %{$rec->{nicks}})
 307         {
 308             my($age) = $runtime - $rec->{nicks}->{$nick}->{record_time};
 309 
 310             if ($rec->{nicks}->{$nick}->{busy})
 311             {
 312                 # Re-calculate the number of pending requests
 313                 $busy = $busy + 1;
 314 
 315                 # we can safely delete it because 600 seconds should have
 316                 # caused a good oldfashioned ping timeout anyway
 317                 # if the server is not still going to respond after 10 
 318                 # minutes we can crash for all I care
 319                 if ($age > 600)
 320                 {
 321                     Irssi::print(
 322                         "%RWHOIS:%n Giving up on %c$nick%n, because 600 " .
 323                         "seconds have passed since we first asked %c$tag%n.%N"
 324                     ) if ($whois_debug);
 325 
 326                     # We have one request less to process now
 327                     $busy = $busy - 1;
 328 
 329                     # Drop the request completely and forget all about this
 330                     # nick
 331                     delete $rec->{nicks}->{$nick};
 332                 }
 333             }
 334             elsif ($age >= 2 * $whois_maxage)
 335             {
 336                 delete $rec->{nicks}->{$nick};
 337             }
 338 
 339             $rec->{processing} = $busy;
 340         }
 341     }
 342 }
 343 
 344 ################################################################################
 345 
 346 # This is a very simple job to warp the call to the garbage collector. Used to
 347 # be self-scheduling, but irssi happily does that for us
 348 #
 349 # Pointless function, waste of memory, need one of those in every good
 350 # program, here is mine.
 351 sub aw_gc_scheduler
 352 {
 353     garbage_collector();
 354 }
 355 
 356 ################################################################################
 357 
 358 # Show information about the autowhois stuff and about who we still know
 359 # Basically displays the cache contents. Some stuff may still be in the cache
 360 # though it is already outdated, The barbage collector will take care of 
 361 # those entries
 362 sub cmd_joininfo_info
 363 {
 364     my($runtime) = time();
 365 
 366     foreach my $tag (keys(%servers))
 367     {
 368         my($rec) = $servers{$tag};
 369 
 370         Irssi::printformat(
 371             MSGLEVEL_CRAP,
 372             'ji_whois_list_header',
 373             $tag,
 374             $rec->{processing}
 375         );
 376 
 377         foreach my $nick (keys %{$rec->{nicks}})
 378         {
 379             my($age) = $runtime - $rec->{nicks}->{$nick}->{record_time};
 380             my($status) = "OK";
 381 
 382             if ($rec->{nicks}->{$nick}->{busy})
 383             {
 384                 $status = "BUSY";
 385             }
 386             elsif ($rec->{nicks}->{$nick}->{aborted})
 387             {
 388                 $status = "ABORTED";
 389 
 390                 if ($rec->{nicks}->{$nick}->{known})
 391                 {
 392                     $status = $status . " but KNOWN";
 393                 }
 394             }
 395             else
 396             {
 397                 $status = "COMPLETE";
 398             }
 399 
 400             Irssi::printformat(
 401                 MSGLEVEL_CRAP,
 402                 'ji_whois_list_nick',
 403                 $nick,
 404                 $rec->{nicks}->{$nick}->{realname},
 405                 $rec->{nicks}->{$nick}->{channels},
 406                 $rec->{nicks}->{$nick}->{server},
 407                 $rec->{nicks}->{$nick}->{flags}
 408             );
 409             Irssi::printformat(
 410                 MSGLEVEL_CRAP,
 411                 'ji_whois_list_status',
 412                 $status,
 413                 $age,
 414                 $tag
 415             );
 416         }
 417     }
 418 }
 419 
 420 ################################################################################
 421 
 422 # A timeout is put for this function just after the WHOIS has been sent to
 423 # the server. When the server does not reply, then we will mark the action as
 424 # aborted. If a reply still ariives later (due to lag) that is not a problem
 425 # as it will simply be reported then. The only thing this function makes sure
 426 # of is that the system is not marked busy anymore so other WHOIS requests
 427 # can go through
 428 sub server_whois_timeout
 429 {
 430     my ($server, $nick) = @{$_[0]};
 431     my $rec = $servers{$server->{tag}};
 432 
 433     if ((defined($rec->{nicks}->{$nick}))
 434         && ($rec->{nicks}->{$nick}->{busy} == 1)
 435     )
 436     {
 437         $rec->{nicks}->{$nick}->{aborted} = 1;
 438         $rec->{nicks}->{$nick}->{busy} = 0;
 439 
 440         $rec->{processing} = $rec->{processing} - 1;
 441 
 442         Irssi::print(
 443             "%RWHOIS:%n whois timeout for nick %C$nick%n ".
 444             "(still running $rec->{processing} requests)"
 445         ) if ($whois_debug);
 446     }
 447 
 448     # Run once, so we remove this job
 449     Irssi::timeout_remove($rec->{nicks}->{$nick}->{timeout_job});
 450 }
 451 
 452 ################################################################################
 453 
 454 # Put a whois request on the server (for one nick only) if and only if the
 455 # number of outstanding rrequests on that server is not too high
 456 #
 457 # Also installs an event handler for the next related SHOIS event that the
 458 # server throws at us
 459 sub request_whois
 460 {
 461     my ($server, $nick) = @_;
 462     my $rec = $servers{$server->{tag}};
 463 
 464     return if $server->{chat_type} ne "IRC";
 465 
 466     if ($rec->{processing} > $max_queued_requests)
 467     {
 468         Irssi::print(
 469             "%RWHOIS:%n Ignoring WHOIS request for %C$nick%n (too busy)%N"
 470         ) if ($whois_debug);
 471         record_reset($server, $nick);
 472         return;
 473     }
 474 
 475     $server->redirect_event(
 476         "whois",
 477         1,
 478         $nick,
 479         0, 
 480         "redir autowhois_default",
 481         {
 482             "event 311" => "redir autowhois_realname",
 483             "event 319" => "redir autowhois_channels",
 484             "event 312" => "redir autowhois_server",
 485             "event 301" => "redir autowhois_away",
 486             "event 307" => "redir autowhois_identified",
 487             "event 275" => "redir autowhois_ssl",
 488             "event 310" => "redir autowhois_irchelp",
 489             "event 313" => "redir autowhois_ircop",
 490             "event 325" => "redir autowhois_ircbot",
 491             "event 317" => "redir autowhois_idle",
 492 #           "event 263" => "redir autowhois_busy",
 493             "event 318" => "redir autowhois_end",
 494             "event 401" => "redir autowhois_unknown",
 495             "" => "event empty"
 496         }
 497     );
 498 
 499     $rec->{processing} = $rec->{processing} + 1;
 500 
 501     # This format requests additional information on $nick
 502     # used to be: $server->send_raw("WHOIS $nick :$nick");
 503     $server->send_raw("WHOIS $nick");
 504 
 505     $rec->{nicks}->{$nick}->{timeout_job} = Irssi::timeout_add(
 506                                                 $whois_timeout,
 507                                                 \&server_whois_timeout,
 508                                                 [$server, $nick]
 509                                             );
 510 }
 511 
 512 ################################################################################
 513 
 514 # A whois record is built as and when server messages with info for a specific
 515 # user arrive. After the WHOIS END message has arrived for that user, we can
 516 # report the stored whois information with this function.
 517 sub report_stored_whois_info
 518 {
 519     my ($server, $nick) = @_;
 520     my $rec = $servers{$server->{tag}};
 521 
 522     if (!defined($rec->{nicks}->{$nick}))
 523     {
 524         Irssi::print(
 525             "%RWHOIS:%n Report called for undefined hash %C$nick%N"
 526         ) if ($whois_debug);
 527         return;
 528     }
 529 
 530     foreach my $channame (@{$rec->{nicks}->{$nick}->{queued_channels}})
 531     {
 532         my $chanrec = $server->channel_find($channame);
 533 
 534         if ($chanrec)
 535         {
 536             $rec->{nicks}->{$nick}->{flags} =~ s/[ ]{1,}$//;
 537 
 538             $chanrec->printformat(
 539                 $whois_printing_level_n,
 540                 'ji_whois_success',
 541                 $nick,
 542                 $rec->{nicks}->{$nick}->{realname},
 543                 $rec->{nicks}->{$nick}->{channels},
 544                 $rec->{nicks}->{$nick}->{server},
 545                 $rec->{nicks}->{$nick}->{flags}
 546             );
 547         }
 548         else
 549         {
 550             Irssi::print(
 551                 "%RWHOIS:%n chanrec not found for %W$channame%n :-(%N"
 552             ) if ($whois_debug);
 553         }
 554     }
 555 
 556     $rec->{nicks}->{$nick}->{queued_channels} = [];
 557 }
 558 
 559 ################################################################################
 560 
 561 # Create an empty record for this nick on that server, we will gradually fill
 562 # out this record as and when we go along.
 563 sub record_reset
 564 {
 565     my ($server, $nick) = @_;
 566     my $rec = $servers{$server->{tag}};
 567 
 568     if (defined($rec->{nicks}->{$nick}))
 569     {
 570         delete $rec->{nicks}->{$nick};
 571     }
 572 
 573     $rec->{nicks}->{$nick} =
 574     {
 575         record_time     => time(),
 576         queued_channels => [],
 577         realname        => "(unknown)",
 578         channels        => "(unknown)",
 579         server          => "(unknown)",
 580         flags           => "",
 581         aborted         => 0,
 582         busy            => 0,
 583         known           => 0,
 584         timeout_job     => 0
 585     };
 586 }
 587 
 588 ################################################################################
 589 
 590 # Sent when a user joins a channel we are on, whic is where we check if we
 591 # have the user info cached, if it is still valid, and if not we put
 592 # a WHOIS request on the server for this user and are done.
 593 sub event_join
 594 {
 595     my ($server, $channame, $nick, $host) = @_;
 596 
 597     return if $server->{chat_type} ne "IRC";
 598     
 599     $channame =~ s/^://;
 600     my $rec = $servers{$server->{tag}};
 601 
 602     return if ($nick eq $server->{nick});
 603 
 604     return if ($server->netsplit_find($nick, $host));
 605 
 606     if (!defined($rec->{nicks}->{$nick}))
 607     {
 608         # If the nick has no requests joined yet, we will create a new
 609         # empty record for the nick, so we can assume later it does
 610         # exist
 611         record_reset($server, $nick);
 612     }
 613 
 614     if (($rec->{nicks}->{$nick}->{known})
 615         && ((time() - $rec->{nicks}->{$nick}->{record_time}) <= $whois_maxage)
 616     )
 617     {
 618         # If we asked less than whois_maxage seconds ago for a WHOIS on this
 619         # nick, we will not re-issue a request.
 620         #
 621         # NOTE: When a person (manually) joins multiple channels you are
 622         #       on, this may cause you not seeing all channels in the
 623         #       channel list, You can set this to something like 5
 624         #       seconds to reduce the probability of this happening
 625         push @{$rec->{nicks}->{$nick}->{queued_channels}}, $channame;
 626 
 627         report_stored_whois_info($server, $nick);
 628     }
 629     elsif ($rec->{nicks}->{$nick}->{busy} == 1)
 630     {
 631         # If we already issued a WHOIS request for this nick but did not
 632         # receive a result yet, we just push this channel name on the
 633         # list of channels that want a report when the result is known
 634         push @{$rec->{nicks}->{$nick}->{queued_channels}}, $channame;
 635     }
 636     else
 637     {
 638         # Finally, we are not already processing this nick, and either
 639         # we have no information for it, or the information we have is
 640         # too old, so we send a WHOIS request to the server.
 641         push @{$rec->{nicks}->{$nick}->{queued_channels}}, $channame;
 642 
 643         $rec->{nicks}->{$nick}->{busy} = 1;
 644 
 645         request_whois($server, $nick);
 646     }
 647 }
 648 
 649 ################################################################################
 650 
 651 # Implementation of the WFORCE <nick> command. Useful for testing purposes
 652 # only, for example to see if the theme changes you made are correct, if the
 653 # timeouts are interpreted properly, and if the garbage collector works
 654 sub cmd_joininfo_force
 655 {
 656     my ($data, $server, $window) = @_;
 657     $data =~ s/^[ ]{1,}//g;
 658     $data =~ s/[ ]{1,}$//g;
 659 
 660     if (!$server || !$server->{connected})
 661     {
 662         Irssi::print("Not connected.");
 663         return;
 664     }
 665 
 666     if ($window->{type} ne "CHANNEL")
 667     {
 668         Irssi::print("Not a channel window.");
 669         return;
 670     }
 671 
 672     event_join($server, $window->{name}, $data, "testuser\@test.example.com");
 673 }
 674 
 675 ################################################################################
 676 
 677 # Event handler for the whois realname line returned by the server. When we
 678 # issue a whois request, we bind an event handler for whois info for that
 679 # nick.
 680 #
 681 # Does nothing, except for updating the record for that nick.
 682 sub event_whois_realname
 683 {
 684     my ($server, $data) = @_;
 685     my ($num, $nick, $user, $host, $empty, $realname) = split(/ +/, $data, 6);
 686     $realname =~ s/^://;
 687     my $rec = $servers{$server->{tag}};
 688 
 689     $rec->{nicks}->{$nick}->{realname} = $realname;
 690 }
 691 
 692 ################################################################################
 693 
 694 # Event handler for the whois channels line returned by the server. When we
 695 # issue a whois request, we bind an event handler for whois info for that
 696 # nick.
 697 #
 698 # Does nothing, except for updating the record for that nick.
 699 sub event_whois_channels
 700 {
 701     my ($server, $data) = @_;
 702     my ($num, $nick, $channels) = split(/ +/, $data, 3);
 703     $channels =~ s/^://;
 704     my $rec = $servers{$server->{tag}};
 705 
 706     $channels =~ s/[ ]{1,}$//;
 707     $rec->{nicks}->{$nick}->{channels} = $channels;
 708 }
 709 
 710 ################################################################################
 711 
 712 # Event handler for the whois server line returned by the server. When we
 713 # issue a whois request, we bind an event handler for whois info for that
 714 # nick.
 715 #
 716 # Does nothing, except for updating the record for that nick.
 717 #
 718 # NOTE: In the default report the server is not repported, it is however
 719 # stored in the record, so if you need it, you can simply update the
 720 # reporting function to show it.
 721 sub event_whois_server
 722 {
 723     my ($server, $data) = @_;
 724     my ($num, $nick, $serverstr) = split(/ +/, $data, 3);
 725     $serverstr =~ s/^://;
 726     my $rec = $servers{$server->{tag}};
 727 
 728     $serverstr =~ s/ :.*$//;
 729 
 730     $rec->{nicks}->{$nick}->{server} = $serverstr;
 731 }
 732 
 733 ################################################################################
 734 
 735 # This is the end of the whois request, all info available we should have
 736 # now, so we mark the record as know, not bust, timestamp it so we can
 737 # expire it later and we report back to the user on those channels waiting
 738 # for whois info for nick
 739 #
 740 # Note that a No Such Nick error is not always followed by a WHOIS END.
 741 # hyb7-based servers interpret the RFC differently from for example hyb6
 742 # and the IRCNet servers and will not send the WHOIS END line, but just
 743 # the No Such Nick error (401).
 744 sub event_whois_end
 745 {
 746     my($server, $data) = @_;
 747     my ($num, $nick, $serverstr) = split(/ +/, $data, 3);
 748     my $rec = $servers{$server->{tag}};
 749 
 750     $rec->{nicks}->{$nick}->{record_time} = time();
 751     $rec->{nicks}->{$nick}->{known} = 1;
 752     $rec->{nicks}->{$nick}->{busy} = 0;
 753 
 754     if (!$rec->{nicks}->{$nick}->{aborted})
 755     {
 756         $rec->{processing} = $rec->{processing} - 1;
 757     }
 758 
 759     report_stored_whois_info($server, $nick);
 760 }
 761 
 762 ################################################################################
 763 
 764 # Some servers (hyb7) do not send an end of whois when the nick is
 765 # not known, they just send a 401 unknown message. Ircnet sends both, hyb6
 766 # sends both, but other servers seem to interpret the RFC differently. We
 767 # just treat this event_whois_unknown as a 318 tag, and mark the lookup
 768 # aborted (which it is in some way)
 769 sub event_whois_unknown
 770 {
 771     my($server, $data) = @_;
 772     my ($num, $nick, $serverstr) = split(/ +/, $data, 3);
 773     my $rec = $servers{$server->{tag}};
 774 
 775     # Fill out the record with some bogus information, so when we
 776     # end up reporting it, we can at least see what is going on.
 777     $rec->{nicks}->{$nick}->{record_time} = time();
 778     $rec->{nicks}->{$nick}->{known} = 1;
 779     $rec->{nicks}->{$nick}->{busy} = 0;
 780     $rec->{nicks}->{$nick}->{realname} = "(unknown)";
 781     $rec->{nicks}->{$nick}->{channels} = "(unknown)";
 782     $rec->{nicks}->{$nick}->{server}   = "(unknown)";
 783     $rec->{nicks}->{$nick}->{flags}    = "(unknown)";
 784 
 785     if (!$rec->{nicks}->{$nick}->{aborted})
 786     {
 787         $rec->{processing} = $rec->{processing} - 1;
 788         $rec->{nicks}->{$nick}->{aborted} = 1;
 789     }
 790 
 791     report_stored_whois_info($server, $nick);
 792 }
 793 
 794 ################################################################################
 795 
 796 # If the server is busy
 797 sub event_whois_busy
 798 {
 799     my($server, $data) = @_;
 800     my($num, $nick, $serverstr) = split(/ +/, $data, 3);
 801     my($rec) = $servers{$server->{tag}};
 802 
 803     Irssi::print("******************* SERVER BUSY *******************************");
 804 }
 805 
 806 ################################################################################
 807 
 808 # No clue what this is for, maybe I should read the irssi documentation
 809 # (if it existed....)
 810 #
 811 # Judging from the debug output this function is never called.
 812 sub event_whois_default
 813 {
 814     my($server, $nick) = @_;
 815     my $rec = $servers{$server->{tag}};
 816 
 817     Irssi::print(
 818         "%RWHOIS:%n Got event_whois_default, ignoring."
 819     ) if ($whois_debug);
 820 }
 821 
 822 ################################################################################
 823 
 824 # Some chat networks support extra falgs for their users and display those
 825 # in WHOIS results. The following fields allow this information to be
 826 # stored in the channel records and to be displayed as well.
 827 
 828 sub event_whois_away
 829 {
 830     my ($server, $data) = @_;
 831     my $rec = $servers{$server->{tag}};
 832     my ($num, $nick, $msg) = split(/ +/, $data, 3);
 833     $msg =~ s/^://;
 834     $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."Away ";
 835 }
 836 
 837 ################################################################################
 838 
 839 sub event_whois_identified
 840 {
 841     my ($server, $data) = @_;
 842     my $rec = $servers{$server->{tag}};
 843     my ($num, $nick, $msg) = split(/ +/, $data, 3);
 844     $msg =~ s/^://;
 845     $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."NickREG ";
 846 }
 847 
 848 ################################################################################
 849 
 850 sub event_whois_ssl
 851 {
 852     my ($server, $data) = @_;
 853     my $rec = $servers{$server->{tag}};
 854     my ($num, $nick, $msg) = split(/ +/, $data, 3);
 855     $msg =~ s/^://;
 856     $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."SSL ";
 857 }
 858 
 859 ################################################################################
 860 
 861 sub event_whois_irchelp
 862 {
 863     my ($server, $data) = @_;
 864     my $rec = $servers{$server->{tag}};
 865     my ($num, $nick, $msg) = split(/ +/, $data, 3);
 866     $msg =~ s/^://;
 867     $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."IrcHELP ";
 868 }
 869 
 870 ################################################################################
 871 
 872 sub event_whois_ircop
 873 {
 874     my ($server, $data) = @_;
 875     my $rec = $servers{$server->{tag}};
 876     my ($num, $nick, $msg) = split(/ +/, $data, 3);
 877     $msg =~ s/^://;
 878     $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."IrcOP ";
 879 }
 880 
 881 ################################################################################
 882 
 883 sub event_whois_ircbot
 884 {
 885     my ($server, $data) = @_;
 886     my $rec = $servers{$server->{tag}};
 887     my ($num, $nick, $msg) = split(/ +/, $data, 3);
 888     $msg =~ s/^://;
 889     $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."IrcBOT ";
 890 }
 891 
 892 ################################################################################
 893 
 894 sub number_to_timestr
 895 {
 896     my($number) = @_;
 897     my ($result) = "";
 898 
 899     # Force integer
 900     $number = 1 * $number;
 901 
 902     my($days) = $number / 86400;
 903     $number = $number % 86400;
 904     my($hours) = $number / 3600;
 905     $number = $number % 3600;
 906     my($minutes) = $number / 60;
 907     $number = $number % 60;
 908     my($seconds) = $number;
 909 
 910     if ($days) { $result = $result . "${days}d"; }
 911     if ($hours || $result) { $result = $result . "${hours}h"; }
 912     if ($minutes || $result) { $result = $result . "${minutes}m"; }
 913     $result = $result . "${seconds}s";
 914 
 915     return $result;
 916 }
 917 
 918 ################################################################################
 919 
 920 sub event_whois_idle
 921 {
 922     my ($server, $data) = @_;
 923     my $rec = $servers{$server->{tag}};
 924     my ($num, $nick, $msg) = split(/ +/, $data, 3);
 925     $msg =~ s/^://;
 926 
 927     if ($msg =~ /^([0-9]{1,}) ([0-9]{1,}) :.*$/)
 928     {
 929         my($idle) = 1 * $1;
 930         my($signon) = 1 * $2;
 931 
 932         $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}
 933             . "Idle=" . number_to_timestr($idle). " ";
 934     }
 935     elsif ($msg =~ /^([0-9]{1,}) :.*$/)
 936     {
 937         my($idle) = 1 * $1;
 938 
 939         $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}
 940             . "Idle=" . number_to_timestr($idle). " ";
 941     }
 942     else
 943     {
 944         $rec->{nicks}->{$nick}->{flags} = $rec->{nicks}->{$nick}->{flags}."SameSRV ";
 945     }
 946 }
 947 
 948 ################################################################################
 949 
 950 # Initializes a server record for the autowhois. Either called when a server
 951 # does connect to the network, or on script load for all connected servers at
 952 # that time
 953 sub event_connected
 954 {
 955     my($server) = @_;
 956 
 957     $servers{$server->{tag}} = {
 958         processing => 0,    # waiting reply for WHOIS request
 959         nicks => {}         # nick => [ #chan1, #chan2, .. ]
 960     };
 961 }
 962 
 963 ################################################################################
 964 
 965 # Deletes a server record for the autowhois. We do this on disconnect
 966 sub event_disconnected
 967 {
 968     my($server) = @_;
 969 
 970     delete $servers{$server->{tag}};
 971 }
 972 
 973 ################################################################################
 974 
 975 # Implementation of what I call the /JOININFO umbrella command. Below
 976 # we bind all subcommands for this command already, so all we need to
 977 # do is hand off the event to irssi again so it can call the right
 978 # implementation function for it.
 979 sub cmd_joininfo
 980 {
 981     my ($data, $server, $item) = @_;
 982     $data =~ s/\s+$//g;
 983     Irssi::command_runsub ('joininfo', $data, $server, $item);
 984 }
 985 
 986 ################################################################################
 987 
 988 # Shows help
 989 sub cmd_joininfo_help
 990 {
 991     Irssi::print( <<EOF
 992 
 993 JOININFO FORCE <nick>
 994 JOININFO GC
 995 JOININFO INFO
 996 JOININFO HELP
 997 
 998 JOININFO FORCE <nick>
 999   Fakes the join of a certain nick to the channel, and shows you
1000   what the WHOIS line would look like.
1001 JOININFO GC
1002   Forces running the garbage collector once
1003 JOININFO INFO
1004   Shows the WHOIS cache as it exists. Note that records in the cache
1005   may be outdated but not deleted yet by the garbage collector
1006 JOININFO HELP
1007   This page
1008 
1009 Example:
1010  JOININFO FORCE ichiban
1011 
1012 Settings:
1013   Use /SET to change whois_expire_time, whois_max_requests,
1014   whois_timeout_ms, whois_gc_interval_ms, whois_debug, or
1015   whois_printing_level
1016 
1017 These settings:
1018   Use /FORMAT to change ji_whois_success, ji_whois_list_header,
1019   ji_whois_list_nick, or ji_whois_list_status
1020 
1021 Note: If you want to hilight certain channels in the output, just use
1022 /HILIGHT -level JOINS #channel
1023 
1024 See also: HILIGHT
1025 EOF
1026     , MSGLEVEL_CLIENTCRAP);
1027 }
1028 
1029 ################################################################################
1030 
1031 # Tegister messages for /FORMAT and theme support
1032 register_messages();
1033 
1034 # Register settings for /SET support
1035 register_settings();
1036 
1037 # Load the previously stored settings from the config file, will be called
1038 # again later each time the settings change
1039 load_settings();
1040 
1041 ################################################################################
1042 
1043 # Mark all currently connected servers as connected
1044 foreach my $server (Irssi::servers()) 
1045 {
1046     event_connected($server);
1047 }
1048 
1049 ################################################################################
1050 
1051 # Add and register our signal handlers
1052 Irssi::signal_add(
1053 {   'server connected'              => \&event_connected,
1054     'server disconnected'           => \&event_disconnected,
1055     'message join'                  => \&event_join,
1056     'redir autowhois_realname'      => \&event_whois_realname,
1057     'redir autowhois_channels'      => \&event_whois_channels,
1058     'redir autowhois_server'        => \&event_whois_server,
1059     'redir autowhois_away'          => \&event_whois_away,
1060     'redir autowhois_identified'    => \&event_whois_identified,
1061     'redir autowhois_ssl'           => \&event_whois_ssl,
1062     'redir autowhois_irchelp'       => \&event_whois_irchelp,
1063     'redir autowhois_ircop'         => \&event_whois_ircop,
1064     'redir autowhois_ircbot'        => \&event_whois_ircbot,
1065     'redir autowhois_idle'          => \&event_whois_idle,
1066     'redir autowhois_end'           => \&event_whois_end,
1067     'redir autowhois_unknown'       => \&event_whois_unknown,
1068     'redir autowhois_busy'          => \&event_whois_busy,
1069     'setup changed'                 => \&load_settings }
1070 );
1071 
1072 ################################################################################
1073 
1074 # Schedule the garbase collector to run every whois_gc_interval ms
1075 Irssi::timeout_add(
1076     $whois_gc_interval,
1077     \&aw_gc_scheduler,
1078     0
1079 );
1080 
1081 ################################################################################
1082 
1083 # OLD STYLE COMMANDS ARE DISABLED AND REPLACED BY /JOININFO WITH SUB-COMMANDS
1084 # Bind the /AWFORCE, /AWGC and /AWINFO commands. Uncomment the next three lines
1085 # if you would like to keep the old-style commands
1086 ### Irssi::command_bind("awforce", "cmd_joininfo_force");
1087 ### Irssi::command_bind("awgc", "garbage_collector");
1088 ### Irssi::command_bind("awinfo", "cmd_joininfo_info");
1089 
1090 Irssi::command_bind("joininfo force", \&cmd_joininfo_force);
1091 Irssi::command_bind("joininfo gc", \&garbage_collector);
1092 Irssi::command_bind("joininfo info", \&cmd_joininfo_info);
1093 Irssi::command_bind("joininfo help", \&cmd_joininfo_help);
1094 Irssi::command_bind("joininfo", \&cmd_joininfo);
1095 
1096 ################################################################################
1097 ### EOF