Xchat/XPI/Net.pm

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