Xchat/XPI/Net.pm

   1 package Xchat::XPI::Net;
   2
   3 use strict;
   4 use warnings;
   5
   6 use IO::Socket::INET;
   7
   8 use Net::DNS;
   9
  10 use Xchat qw<:all>;
  11
  12 our $VERSION = '0.03';
  13
  14 my $res;
  15
  16 BEGIN {
  17  $res = Net::DNS::Resolver->new;
  18
  19  my $timeout = 5;
  20  $res->tcp_timeout($timeout);
  21  $res->udp_timeout($timeout);
  22
  23  my $nameservers = '';
  24  $res->nameservers( [ split ' ', $nameservers ] ) if $nameservers;
  25 }
  26
  27 sub resolve {
  28  my ($host, $callback) = @_[0, 1];
  29  return unless $host && $callback;
  30  my $args = $_[2];
  31  my $sock = $res->bgsend($host);
  32  return unless $sock;
  33  $sock->autoflush(1);
  34  my $hook = Xchat::hook_fd($sock, \&_dns_recv, { flags => FD_READ, data => [ $callback, $args ] } );
  35  return $hook;
  36 }
  37
  38 sub _dns_recv {
  39  my $fd = $_[0];
  40  my ($callback, $args) = @{$_[2]};
  41  my $p = $res->bgread($fd);
  42  $fd->shutdown(2);
  43  close $fd;
  44  undef $fd;
  45  &$callback($p, $args);
  46  return REMOVE;
  47 }
  48
  49 my %whois_servers = (
  50  domain => {
  51   default => 'whois.internic.net',
  52      arpa => 'whois.arin.net',
  53 #      mil => 'whois.nic.mil',
  54  },
  55  ipv4 => { default => 'whois.ripe.net' },
  56  ipv6 => { default => 'whois.6bone.net' }
  57 );
  58
  59 sub whois {
  60  my ($host, $callback) = @_[0, 1];
  61  return unless $host && $callback;
  62  my $args = $_[2];
  63  my $server;
  64  if ($host =~ /^\s*\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(\/\d{1,2})?$/) {
  65   $server = $whois_servers{ipv4}{default};
  66  } elsif ($host =~ /^\s*[\d:]*(\/\d{1,2})?\s*$/) {
  67   $server = $whois_servers{ipv6}{default};
  68  } elsif ($host =~ /([^\.]+)\.+([a-z]+)\.*$/) {
  69   $host = $1.'.'.$2;
  70   $server = $whois_servers{domain}{$2};
  71   $server = $whois_servers{domain}{default} if !$server;
  72  }
  73  return unless $server;
  74  my $hook;
  75
  76 # resolve($server, \&_whois_send, [ \$hook, $host, $callback, $args ] );
  77 # return \$hook;
  78 #}
  79 #
  80 #sub _whois_send {
  81 # my $p = $_[0];
  82 # my @a = grep { $_->type eq 'A' && $_->address } $p->answer;
  83 # return unless @a;
  84 # my ($hookref, $host, $callback, $args) = @{$_[1]};
  85 # my $server = $a[rand(@a)]->address;
  86
  87  my $sock = IO::Socket::INET->new(
  88   PeerAddr => $server,
  89   PeerPort => 43,
  90   Proto => 'tcp'
  91  ) or return;
  92  $sock->autoflush(1);
  93  print $sock "$host\x0D\x0A";
  94  $sock->shutdown(1); # stop writing
  95  $hook = Xchat::hook_fd($sock, \&_whois_recv, { flags => FD_READ, data => [ $callback, $args ] } );
  96  return $hook;
  97 }
  98
  99 sub _whois_recv {
 100  my $fd = $_[0];
 101  my ($callback, $args) = @{$_[2]};
 102  my $raw = do { local $/; <$fd>; };
 103  $fd->shutdown(2);
 104  close $fd;
 105  undef $fd;
 106  &$callback($raw, $args);
 107  return REMOVE;
 108 }
 109
 110 use base qw<Exporter>;
 111
 112 our @EXPORT         = ();
 113 our %EXPORT_TAGS    = ('funcs' => [ qw<resolve whois> ]);
 114 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
 115 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
 116
 117 1;