diff options
Diffstat (limited to 'scripts/dns.pl')
| -rw-r--r-- | scripts/dns.pl | 236 |
1 files changed, 236 insertions, 0 deletions
diff --git a/scripts/dns.pl b/scripts/dns.pl new file mode 100644 index 0000000..9e9f478 --- /dev/null +++ b/scripts/dns.pl @@ -0,0 +1,236 @@ +# /DNS <nick>|<host>|<ip> ... +# +# v2.2 +# add ipv6 support +# v2.1.1 +# updated the script to fix a bug where the script would let +# a trailing whitespace go through (ex: tab completion) +# - inch <inch@stmpd.net> + +use strict; +use Socket; +use POSIX; + +use vars qw($VERSION %IRSSI); +$VERSION = "2.2"; +%IRSSI = ( + authors => "Timo \'cras\' Sirainen", + contact => "tss\@iki.fi", + name => "dns", + description => "/DNS <nick>|<host>|<ip> ...", + license => "Public Domain", + url => "http://irssi.org/", + changed => "2019-01-24" +); + +my (%resolve_hosts, %resolve_nicks, %resolve_print); # resolve queues +my $userhosts; # number of USERHOSTs currently waiting for reply +my $lookup_waiting; # 1 if we're waiting a reply for host lookup + +# for the current host lookup +my ($print_server, $print_host, $print_name, @print_ips); +my ($input_skip_next, $input_query); + +my $pipe_tag; + +sub cmd_dns { + my ($nicks, $server) = @_; + return if !$nicks; + $nicks =~ s/\s+$//; + # get list of nicks/hosts we want to know + my $tag = !$server ? undef : $server->{tag}; + my $ask_nicks = ""; + my $print_error = 0; + foreach my $nick (split(" ", $nicks)) { + $nick = lc($nick); + if ($nick =~ /[\.:]/) { + # it's an IP or hostname + $resolve_hosts{$nick} = $tag; + } else { + # it's nick + if (!$print_error && (!$server || !$server->{connected})) { + $print_error = 1; + Irssi::print("Not connected to server"); + } else { + $resolve_nicks{$nick} = 1; + $ask_nicks .= "$nick "; + } + } + } + + if ($ask_nicks ne "") { + # send the USERHOST query + $userhosts++; + $server->redirect_event('userhost', 1, $ask_nicks, 0, 'redir dns failure', { + 'event 302' => 'redir dns host', + '' => 'event empty' } ); + $server->send_raw("USERHOST :$nicks"); + } + + # ask the IPs/hostnames immediately + host_lookup() if (!$lookup_waiting); +} + +sub sig_failure { + Irssi::print("Error getting hostname for nick"); + %resolve_nicks = () if (--$userhosts == 0); +} + +sub sig_userhost { + my ($server, $data) = @_; + $data =~ s/^[^ ]* :?//; + my @hosts = split(/ +/, $data); + + # move resolve_nicks -> resolve_hosts + foreach my $host (@hosts) { + if ($host =~ /^([^=\*]*)\*?=.(.*)@(.*)/) { + my $nick = lc($1); + my $user = $2; + $host = lc($3); + + $resolve_hosts{$host} = $resolve_nicks{$nick}; + delete $resolve_nicks{$nick}; + $resolve_print{$host} = "[$nick!$user"."@"."$host]"; + } + } + + if (--$userhosts == 0 && %resolve_nicks) { + # unknown nicks - they didn't contain . or : so it can't be + # IP or hostname. + Irssi::print("Unknown nicks: ".join(' ', keys %resolve_nicks)); + %resolve_nicks = (); + } + + host_lookup() if (!$lookup_waiting); +} + +sub dns { + my ($host) =@_; + my %hints = (socktype => SOCK_STREAM); + my ($err, @res) = Socket::getaddrinfo($host, "http", \%hints); + my @res1; + if ($err ==0 ) { + foreach(@res) { + if ($_->{family}==AF_INET) { + my ($proto,$ip)=unpack_sockaddr_in($_->{addr}); + push @res1, Socket::inet_ntop(AF_INET,$ip); + } + if ($_->{family}==AF_INET6) { + my ($proto,$ip)=unpack_sockaddr_in6($_->{addr}); + push @res1, Socket::inet_ntop(AF_INET6,$ip); + } + } + return join(' ',@res1); + } +} + +sub rdns { + my ($host) =@_; + my %hints = (socktype => SOCK_STREAM); + my ($err, @res) = Socket::getaddrinfo($host, "http", \%hints); + my @res1; + if ($err ==0 ) { + foreach(@res) { + my ($err, $hostname, $servicename) = Socket::getnameinfo $_->{addr}; + if ($err ==0) { + push @res1, $hostname; + } + } + return join(' ',@res1); + } +} + +sub host_lookup { + return if (!%resolve_hosts); + + my ($host) = keys %resolve_hosts; + $print_server = $resolve_hosts{$host}; + + $print_host = undef; + $print_name = $resolve_print{$host}; + @print_ips = (); + + delete $resolve_hosts{$host}; + delete $resolve_print{$host}; + + $input_query = $host; + $input_skip_next = 0; + + # pipe is used to get the reply from child + my ($rh, $wh); + pipe($rh, $wh); + + # non-blocking host lookups with fork()ing + my $pid = fork(); + if (!defined($pid)) { + %resolve_hosts = (); + %resolve_print = (); + Irssi::print("Can't fork() - aborting"); + close($rh); close($wh); + return; + } + $lookup_waiting++; + + if ($pid > 0) { + # parent, wait for reply + close($wh); + Irssi::pidwait_add($pid); + $pipe_tag = Irssi::input_add(fileno($rh), INPUT_READ, \&pipe_input, $rh); + return; + } + + my $text; + eval { + # child, do the lookup + my $name = ""; + if ($host =~ /^[0-9\.]*$/ || $host =~ m/^[0-9a-f:]*$/) { + # ip -> host + #$name = gethostbyaddr(inet_aton($host), AF_INET); + $name = rdns($host); + } else { + # host -> ip + $name = dns($host); + } + + $print_name = $input_query if !$print_name; + if (!$name) { + $text = "No information for $print_name"; + } else { + $text = "$print_name: $name"; + } + }; + $text = $! if (!$text); + + eval { + # write the reply + print($wh $text); + close($wh); + }; + POSIX::_exit(1); +} + +sub pipe_input { + my $rh = shift; + my $text = <$rh>; + close($rh); + + Irssi::input_remove($pipe_tag); + $pipe_tag = -1; + + my $server = Irssi::server_find_tag($print_server); + if ($server) { + $server->print('', $text); + } else { + Irssi::print($text); + } + + $lookup_waiting--; + host_lookup(); +} + +Irssi::command_bind('dns', 'cmd_dns'); +Irssi::signal_add( { + 'redir dns failure' => \&sig_failure, + 'redir dns host' => \&sig_userhost } ); + +# vim:set sw=2 ts=8: |