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