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 use Xchat::XPI::Utils qw<save_context>;
  15
  16 our $VERSION = '0.02';
  17
  18 my $ph;
  19
  20 sub parse_url {
  21  local $_ = $_[0];
  22  return unless defined;
  23  my %h = ();
  24  if (s/^([^:]*)://) { $h{proto} = lc $1; }
  25  ($_, my @path) = grep length, (split m!/!);
  26  return unless defined;
  27  if (s/:([0-9]*)$// && length $1) { $h{port} = $1; }
  28  if (s/(.*)@([^@]*)$/$2/) { ($h{user}, $h{passwd}) = split /:/, $1, 2; }
  29  $h{host} = lc;
  30  $h{path} = \@path if @path;
  31  return \%h;
  32 }
  33
  34 sub output {
  35  my ($motif, $head, @strings) = @_;
  36  $head = join ' ', ($motif x 3), $head, ($motif x 3);
  37  if (@strings) {
  38   my $l = max(map length, @strings) - length($head) - 1; # -1 for CR
  39   $head .= ($motif x $l) if $l > 0;
  40  }
  41  print $ph "\002$head\n", @strings;
  42 }
  43
  44 hook_command 'DIG', sub {
  45  my @reqs = @{$_[0]};
  46  shift @reqs;
  47  return EAT_ALL unless @reqs;
  48  my @users = get_info('users');
  49  my $context = get_context;
  50  for (@reqs) {
  51   my $info = user_info $_;
  52   my $req = parse_url($info ? $info->{host} : $_);
  53   resolve $req->{host}, \&dig_print, [ $context, $req ];
  54  }
  55  return EAT_ALL;
  56 }, {
  57  help_text => 'DIG <ip(s)/hostname(s)>, resolve given names/addresses'
  58 };
  59
  60 sub dig_print {
  61  my $p = $_[0];
  62  my ($context, $req) = @{$_[1]};
  63  my $guard = save_context;
  64  set_context $context;
  65  if ($p) {
  66   my @a = $p->answer;
  67   if (@a) {
  68    output '-', 'Results for ' . $req->{host},
  69              map { $_->string . "\n" } (@a, $p->authority, $p->additional);
  70   } else {
  71    output '*', 'Resolution failed for ' . $req->{host},
  72           map {
  73            $_->mname . ' IN SOA ' . $_->rname . "\n",
  74            join ' ', 'serial:' . $_->serial, 'ref:' . $_->refresh,
  75                      'ret:' . $_->retry, 'exp:' . $_->expire,
  76                      'min:' . $_->minimum . "\n";
  77           } grep { $_->type eq 'SOA' } $p->authority;
  78   }
  79  } else {
  80   print $ph 'Request ' . $req->{host} . " timed out\n";
  81  }
  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 $guard = save_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 }
 116
 117 hook_command 'TLD', sub {
 118  my @reqs = @{$_[0]};
 119  shift @reqs;
 120  return EAT_ALL unless @reqs;
 121  for (@reqs) {
 122   my $info = user_info $_;
 123   my $host = parse_url($info ? $info->{host} : $_)->{host};
 124   my ($tld) = $host =~ /\.([a-z]+)\.*$/;
 125   next unless $tld;
 126   my $name = code2country $tld;
 127   print $ph $tld . ' is ' . ($name ? $name : 'unknown') . "\n";
 128  }
 129  return EAT_ALL;
 130 }, {
 131  help_text => 'TLD <hostname(s)>, give the TLD text representation of the hosts'
 132 };
 133
 134 $ph = Xchat::XPI->new(
 135  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
 143 1;