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, $args) = @_;
  29  return unless $host and $callback;
  30
  31  my $sock = $res->bgsend($host);
  32  return unless $sock;
  33  $sock->autoflush(1);
  34
  35  return Xchat::hook_fd($sock, \&_dns_recv, {
  36   flags => FD_READ,
  37   data  => [ $callback, $args ],
  38  });
  39 }
  40
  41 sub _dns_recv {
  42  my $fh = $_[0];
  43  my ($callback, $args) = @{$_[2]};
  44
  45  my $p = $res->bgread($fh);
  46  $fh->shutdown(2);
  47  close $fh;
  48  undef $fh;
  49
  50  $callback->($p, $args);
  51
  52  return REMOVE;
  53 }
  54
  55 my %whois_servers = (
  56  domain => {
  57   default => 'whois.internic.net',
  58      arpa => 'whois.arin.net',
  59 #      mil => 'whois.nic.mil',
  60  },
  61  ipv4 => { default => 'whois.ripe.net'  },
  62  ipv6 => { default => 'whois.6bone.net' },
  63 );
  64
  65 sub whois {
  66  my ($host, $callback, $args) = @_;
  67  return unless $host and $callback;
  68
  69  my $server;
  70  if ($host =~ /^\s*\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}(\/\d{1,2})?$/) {
  71   $server = $whois_servers{ipv4}{default};
  72  } elsif ($host =~ /^\s*[\d:]*(\/\d{1,2})?\s*$/) {
  73   $server = $whois_servers{ipv6}{default};
  74  } elsif ($host =~ /([^\.]+)\.+([a-z]+)\.*$/) {
  75   $host   = $1 . '.' . $2;
  76   $server = $whois_servers{domain}{$2};
  77   $server = $whois_servers{domain}{default} unless $server;
  78  }
  79  return unless $server;
  80
  81  my $hook;
  82
  83 # resolve($server, \&_whois_send, [ \$hook, $host, $callback, $args ] );
  84 # return \$hook;
  85 #}
  86 #
  87 #sub _whois_send {
  88 # my $p = $_[0];
  89 # my @a = grep { $_->type eq 'A' && $_->address } $p->answer;
  90 # return unless @a;
  91 # my ($hookref, $host, $callback, $args) = @{$_[1]};
  92 # my $server = $a[rand(@a)]->address;
  93
  94  my $sock = IO::Socket::INET->new(
  95   PeerAddr => $server,
  96   PeerPort => 43,
  97   Proto    => 'tcp',
  98  );
  99  return unless $sock;
 100  $sock->autoflush(1);
 101
 102  print $sock "$host\x0D\x0A";
 103  $sock->shutdown(1); # stop writing
 104
 105  return Xchat::hook_fd($sock, \&_whois_recv, {
 106   flags => FD_READ,
 107   data  => [ $callback, $args ],
 108  });
 109 }
 110
 111 sub _whois_recv {
 112  my $fh = $_[0];
 113  my ($callback, $args) = @{$_[2]};
 114
 115  my $raw = do { local $/; <$fh>; };
 116  $fh->shutdown(2);
 117  close $fh;
 118  undef $fh;
 119
 120  $callback->($raw, $args);
 121
 122  return REMOVE;
 123 }
 124
 125 use base qw<Exporter>;
 126
 127 our @EXPORT         = ();
 128 our %EXPORT_TAGS    = ('funcs' => [ qw<resolve whois> ]);
 129 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
 130 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
 131
 132 1;