Make sure local_context() runs the code only when the context was found
[perl/scripts/xchat.git] / 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;