]> git.vpit.fr Git - perl/scripts/xchat.git/blob - Xchat/XPI/Net.pm
9cb99379a4d76a99e97f2d7b9745a4288daa089b
[perl/scripts/xchat.git] / 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;