apps/irssi/scripts/dns.pl

   1 # /DNS <nick>|<host>|<ip> ...
   2
   3 use Irssi;
   4 use strict;
   5 use Socket;
   6 use POSIX;
   7
   8 use vars qw($VERSION %IRSSI);
   9 $VERSION = "2.1";
  10 %IRSSI = (
  11     authors     => 'Timo Sirainen',
  12     name        => 'dns',
  13     description => '/DNS <nick>|<host>|<ip> ...',
  14     license     => 'Public Domain',
  15     changed     => 'Sun Mar 10 23:23 EET 2002'
  16 );
  17
  18 my (%resolve_hosts, %resolve_nicks, %resolve_print); # resolve queues
  19 my $userhosts; # number of USERHOSTs currently waiting for reply
  20 my $lookup_waiting; # 1 if we're waiting a reply for host lookup
  21
  22 # for the current host lookup
  23 my ($print_server, $print_host, $print_name, @print_ips);
  24 my ($input_skip_next, $input_query);
  25
  26 my $pipe_tag;
  27
  28 sub cmd_dns {
  29   my ($nicks, $server) = @_;
  30   return if !$nicks;
  31
  32   # get list of nicks/hosts we want to know
  33   my $tag = !$server ? undef : $server->{tag};
  34   my $ask_nicks = "";
  35   my $print_error = 0;
  36   foreach my $nick (split(" ", $nicks)) {
  37     $nick = lc($nick);
  38     if ($nick =~ /[\.:]/) {
  39       # it's an IP or hostname
  40       $resolve_hosts{$nick} = $tag;
  41     } else {
  42       # it's nick
  43       if (!$print_error && (!$server || !$server->{connected})) {
  44         $print_error = 1;
  45         Irssi::print("Not connected to server");
  46       } else {
  47         $resolve_nicks{$nick} = 1;
  48         $ask_nicks .= "$nick ";
  49       }
  50     }
  51   }
  52
  53   if ($ask_nicks ne "") {
  54     # send the USERHOST query
  55     $userhosts++;
  56     $server->redirect_event('userhost', 1, $ask_nicks, 0, 'redir dns failure', {
  57                             'event 302' => 'redir dns host',
  58                             '' => 'event empty' } );
  59     $server->send_raw("USERHOST :$nicks");
  60   }
  61
  62   # ask the IPs/hostnames immediately
  63   host_lookup() if (!$lookup_waiting);
  64 }
  65
  66 sub sig_failure {
  67   Irssi::print("Error getting hostname for nick");
  68   %resolve_nicks = () if (--$userhosts == 0);
  69 }
  70
  71 sub sig_userhost {
  72   my ($server, $data) = @_;
  73   $data =~ s/^[^ ]* :?//;
  74   my @hosts = split(/ +/, $data);
  75
  76   # move resolve_nicks -> resolve_hosts
  77   foreach my $host (@hosts) {
  78     if ($host =~ /^([^=\*]*)\*?=.(.*)@(.*)/) {
  79       my $nick = lc($1);
  80       my $user = $2;
  81       $host = lc($3);
  82
  83       $resolve_hosts{$host} = $resolve_nicks{$nick};
  84       delete $resolve_nicks{$nick};
  85       $resolve_print{$host} = "[$nick!$user"."@"."$host]";
  86     }
  87   }
  88
  89   if (--$userhosts == 0 && %resolve_nicks) {
  90     # unknown nicks - they didn't contain . or : so it can't be
  91     # IP or hostname.
  92     Irssi::print("Unknown nicks: ".join(' ', keys %resolve_nicks));
  93     %resolve_nicks = ();
  94   }
  95
  96   host_lookup() if (!$lookup_waiting);
  97 }
  98
  99 sub host_lookup {
 100   return if (!%resolve_hosts);
 101
 102   my ($host) = keys %resolve_hosts;
 103   $print_server = $resolve_hosts{$host};
 104
 105   $print_host = undef;
 106   $print_name = $resolve_print{$host};
 107   @print_ips = ();
 108
 109   delete $resolve_hosts{$host};
 110   delete $resolve_print{$host};
 111
 112   $input_query = $host;
 113   $input_skip_next = 0;
 114
 115   # pipe is used to get the reply from child
 116   my ($rh, $wh);
 117   pipe($rh, $wh);
 118
 119   # non-blocking host lookups with fork()ing
 120   my $pid = fork();
 121   if (!defined($pid)) {
 122     %resolve_hosts = ();
 123     %resolve_print = ();
 124     Irssi::print("Can't fork() - aborting");
 125     close($rh); close($wh);
 126     return;
 127   }
 128   $lookup_waiting++;
 129
 130   if ($pid > 0) {
 131     # parent, wait for reply
 132     close($wh);
 133     Irssi::pidwait_add($pid);
 134     $pipe_tag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, $rh);
 135     return;
 136   }
 137
 138   my $text;
 139   eval {
 140     # child, do the lookup
 141     my $name = "";
 142     if ($host =~ /^[0-9\.]*$/) {
 143       # ip -> host
 144       $name = gethostbyaddr(inet_aton($host), AF_INET);
 145     } else {
 146       # host -> ip
 147       my @addrs = gethostbyname($host);
 148       if (@addrs) {
 149         @addrs = map { inet_ntoa($_) } @addrs[4 .. $#addrs];
 150         $name = join (" ", @addrs);
 151       }
 152     }
 153
 154     $print_name = $input_query if !$print_name;
 155     if (!$name) {
 156       $text = "No information for $print_name";
 157     } else {
 158       $text = "$print_name: $name";
 159     }
 160   };
 161   $text = $! if (!$text);
 162
 163   eval {
 164     # write the reply
 165     print($wh $text);
 166     close($wh);
 167   };
 168   POSIX::_exit(1);
 169 }
 170
 171 sub pipe_input {
 172   my $rh = shift;
 173   my $text = <$rh>;
 174   close($rh);
 175
 176   Irssi::input_remove($pipe_tag);
 177   $pipe_tag = -1;
 178
 179   my $server = Irssi::server_find_tag($print_server);
 180   if ($server) {
 181     $server->print('', $text);
 182   } else {
 183     Irssi::print($text);
 184   }
 185
 186   $lookup_waiting--;
 187   host_lookup();
 188 }
 189
 190 Irssi::command_bind('dns', 'cmd_dns');
 191 Irssi::signal_add( {
 192         'redir dns failure' => \&sig_failure,
 193         'redir dns host' => \&sig_userhost } );