net.pl

   1 package Xchat::VPIT::Net;
   2
   3 use strict;
   4 use warnings;
   5
   6 use List::Util      qw/max/;
   7 use Locale::Country qw/code2country/;
   8
   9 use Xchat qw/:all/;
  10
  11 use lib get_info 'xchatdir';
  12 use Xchat::XPI;
  13 use Xchat::XPI::Net qw/resolve whois/;
  14
  15 our $VERSION = '0.02';
  16
  17 my $ph;
  18
  19 sub parse_url {
  20  local $_ = $_[0];
  21  return unless defined;
  22  my %h = ();
  23  if (s/^([^:]*)://) { $h{proto} = lc $1; }
  24  ($_, my @path) = grep length, (split m!/!);
  25  return unless defined;
  26  if (s/:([0-9]*)$// && length $1) { $h{port} = $1; }
  27  if (s/(.*)@([^@]*)$/$2/) { ($h{user}, $h{passwd}) = split /:/, $1, 2; }
  28  $h{host} = lc;
  29  $h{path} = \@path if @path;
  30  return \%h;
  31 }
  32
  33 sub output {
  34  my ($motif, $head, @strings) = @_;
  35  $head = join ' ', ($motif x 3), $head, ($motif x 3);
  36  if (@strings) {
  37   my $l = max(map length, @strings) - length($head) - 1; # -1 for CR
  38   $head .= ($motif x $l) if $l > 0;
  39  }
  40  print $ph "\002$head\n", @strings;
  41 }
  42
  43 hook_command 'DIG', sub {
  44  my @reqs = @{$_[0]};
  45  shift @reqs;
  46  return EAT_ALL unless @reqs;
  47  my @users = get_info('users');
  48  my $context = get_context;
  49  for (@reqs) {
  50   my $info = user_info $_;
  51   my $req = parse_url($info ? $info->{host} : $_);
  52   resolve $req->{host}, \&dig_print, [ $context, $req ];
  53  }
  54  return EAT_ALL;
  55 }, {
  56  help_text => 'DIG <ip(s)/hostname(s)>, resolve given names/addresses'
  57 };
  58
  59 sub dig_print {
  60  my $p = $_[0];
  61  my ($context, $req) = @{$_[1]};
  62  my $oldctxt = get_context;
  63  set_context $context;
  64  if ($p) {
  65   my @a = $p->answer;
  66   if (@a) {
  67    output '-', 'Results for ' . $req->{host},
  68              map { $_->string . "\n" } (@a, $p->authority, $p->additional);
  69   } else {
  70    output '*', 'Resolution failed for ' . $req->{host},
  71           map {
  72            $_->mname . ' IN SOA ' . $_->rname . "\n",
  73            join ' ', 'serial:' . $_->serial, 'ref:' . $_->refresh,
  74                      'ret:' . $_->retry, 'exp:' . $_->expire,
  75                      'min:' . $_->minimum . "\n";
  76           } grep { $_->type eq 'SOA' } $p->authority;
  77   }
  78  } else {
  79   print $ph 'Request ' . $req->{host} . " timed out\n";
  80  }
  81  set_context $oldctxt;
  82 }
  83
  84 hook_command 'NETWHOIS', sub {
  85  my @reqs = @{$_[0]};
  86  shift @reqs;
  87  return EAT_ALL unless @reqs;
  88  my $context = get_context;
  89  for (@reqs) {
  90   my $info = user_info $_;
  91   my $req = parse_url($info ? $info->{host} : $_);
  92   whois $req->{host}, \&netwhois_print, [ $context, $req ];
  93  }
  94  return EAT_ALL;
  95 }, {
  96  help_text => 'NETWHOIS <ip(s)/hostname(s)>, retrieve domain/ip information'
  97 };
  98
  99 sub netwhois_print {
 100  my $raw = $_[0];
 101  my ($context, $req) = @{$_[1]};
 102  my $oldctxt = get_context;
 103  set_context $context;
 104  if ($raw) {
 105   $raw =~ s/.*(Domain|inetnum)/$1/s;
 106   $raw =~ s/[\r\n]*\>\>\>.*//s;
 107   output '-', 'Results for ' . $req->{host},
 108          map {
 109           s/^\s+//; s/\s+$//;
 110           $_ . "\n";
 111          } grep { !/^\s*(#|%)/ } split /\r?\n/, $raw;
 112  } else {
 113   output '*', 'No results for ' . $req->{host};
 114  }
 115  set_context $oldctxt;
 116 }
 117
 118 hook_command 'TLD', sub {
 119  my @reqs = @{$_[0]};
 120  shift @reqs;
 121  return EAT_ALL unless @reqs;
 122  for (@reqs) {
 123   my $info = user_info $_;
 124   my $host = parse_url($info ? $info->{host} : $_)->{host};
 125   my ($tld) = $host =~ /\.([a-z]+)\.*$/;
 126   next unless $tld;
 127   my $name = code2country $tld;
 128   print $ph $tld . ' is ' . ($name ? $name : 'unknown') . "\n";
 129  }
 130  return EAT_ALL;
 131 }, {
 132  help_text => 'TLD <hostname(s)>, give the TLD text representation of the hosts'
 133 };
 134
 135 $ph = new Xchat::XPI name   => 'Networking tools',
 136                      tag    => 'Net',
 137                      desc   => 'DNS & Whois clients, TLD names',
 138                      author => 'Vincent Pit (VPIT)',
 139                      email  => 'perl@profvince.com',
 140                      url    => 'http://www.profvince.com';
 141
 142 1;