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 my $ipv4_rx = qr/[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}/;
  66 my $ipv6_rx = qr/[0-9:]+/;
  67
  68 sub whois {
  69  my ($host, $callback, $args) = @_;
  70  return unless $host and $callback;
  71
  72  my $server;
  73  if ($host =~ /^\s*($ipv4_rx)(?:\/[0-9]{1,2})?[\s\.]*$/o) {
  74   $host   = $1;
  75   $server = $whois_servers{ipv4}{default};
  76  } elsif ($host =~ /^\s*($ipv6_rx)(?:\/[0-9]{1,2})?[\s\.]*$/o) {
  77   $host   = $1;
  78   $server = $whois_servers{ipv6}{default};
  79  } elsif ($host =~ /([^\.]+)\.+([a-z]+)[\.\s]*$/) {
  80   $host   = $1 . '.' . $2;
  81   $server = $whois_servers{domain}{$2};
  82   $server = $whois_servers{domain}{default} unless $server;
  83  }
  84  return unless $server;
  85
  86  my $hook;
  87
  88 # resolve($server, \&_whois_send, [ \$hook, $host, $callback, $args ] );
  89 # return \$hook;
  90 #}
  91 #
  92 #sub _whois_send {
  93 # my $p = $_[0];
  94 # my @a = grep { $_->type eq 'A' && $_->address } $p->answer;
  95 # return unless @a;
  96 # my ($hookref, $host, $callback, $args) = @{$_[1]};
  97 # my $server = $a[rand(@a)]->address;
  98
  99  my $sock = IO::Socket::INET->new(
 100   PeerAddr => $server,
 101   PeerPort => 43,
 102   Proto    => 'tcp',
 103  );
 104  return unless $sock;
 105  $sock->autoflush(1);
 106
 107  print $sock "$host\x0D\x0A";
 108  $sock->shutdown(1); # stop writing
 109
 110  return Xchat::hook_fd($sock, \&_whois_recv, {
 111   flags => FD_READ,
 112   data  => [ $callback, $args ],
 113  });
 114 }
 115
 116 sub _whois_recv {
 117  my $fh = $_[0];
 118  my ($callback, $args) = @{$_[2]};
 119
 120  my $raw = do { local $/; <$fh>; };
 121  $fh->shutdown(2);
 122  close $fh;
 123  undef $fh;
 124
 125  $callback->($raw, $args);
 126
 127  return REMOVE;
 128 }
 129
 130 use base qw<Exporter>;
 131
 132 our @EXPORT         = ();
 133 our %EXPORT_TAGS    = ('funcs' => [ qw<resolve whois> ]);
 134 our @EXPORT_OK      = map { @$_ } values %EXPORT_TAGS;
 135 $EXPORT_TAGS{'all'} = [ @EXPORT_OK ];
 136
 137 1;