[Rt-commit] rtir branch, 5.0/revert-to-old-net-whois-ripe, created. 5.0.0beta1-7-g9670aaeb
? sunnavy
sunnavy at bestpractical.com
Wed Jul 8 14:11:04 EDT 2020
The branch, 5.0/revert-to-old-net-whois-ripe has been created
at 9670aaebe375e17a8b0e8a20724d9ceda383d798 (commit)
- Log -----------------------------------------------------------------
commit 722e5a96005ebdc422d469d23444db12c547afe6
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Jul 9 01:38:49 2020 +0800
Revert "Catch parse failures from Net::Whois::Object"
This reverts commit bb0c93a06100d64adfed331eb2b8898ed2327451.
We are going to revert back to Net::Whois::Ripe 1.x because 2.x doesn't
support general whois parsing.
diff --git a/html/RTIR/Tools/Elements/GetEmailFromIP b/html/RTIR/Tools/Elements/GetEmailFromIP
index 257f0746..a1e7d2f3 100644
--- a/html/RTIR/Tools/Elements/GetEmailFromIP
+++ b/html/RTIR/Tools/Elements/GetEmailFromIP
@@ -62,30 +62,17 @@ unless ( $iterator ) {
$field ||= 'notify';
-# Trap possible failures when parsing results
-# Net::Whois currently dies in some cases, so we need to eval
-my @objects;
-eval {
- @objects = Net::Whois::Object->new($iterator);
-};
-
+my @objects = Net::Whois::Object->new($iterator);
my @res;
-if ( $@ ) {
- RT->Logger->warn('Unable to parse WHOIS results for query ' . $q);
- RT->Logger->debug($@);
- $$error = loc('Unable to parse results from WHOIS lookup');
-}
-else {
- foreach my $obj (@objects) {
- foreach my $attr ( grep lc $_ eq lc $field, $obj->attributes ) {
- push @res, $obj->$attr();
- }
- }
- unless ( @res ) {
- $$error = loc("Whois server response did not include field '[_1]'", $field);
- return;
+foreach my $obj (@objects) {
+ foreach my $attr ( grep lc $_ eq lc $field, $obj->attributes ) {
+ push @res, $obj->$attr();
}
}
+unless ( @res ) {
+ $$error = loc("Whois server response did not include field '[_1]'", $field);
+ return;
+}
($$address) = grep defined && length, @res;
</%INIT>
commit 9670aaebe375e17a8b0e8a20724d9ceda383d798
Author: sunnavy <sunnavy at bestpractical.com>
Date: Thu Jul 9 01:42:53 2020 +0800
Revert "Updated Net::Whois::RIPE to 2.x"
This reverts commit 1ffa0fb951f094b09b4944738cb633a5e5fc4c35.
Sadly that Net::Whois::RIPE 2.x doesn't support general whois parsing,
which we need on scripted action(By IP address) page.
diff --git a/Makefile.PL b/Makefile.PL
index 5ae905fd..fd381ba0 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -25,7 +25,6 @@ if ($^O ne 'VMS') {
# RTIR needs this version of SB because of cud-from-select
requires('DBIx::SearchBuilder', 1.61);
-requires('Net::Whois::RIPE', 2.006001);
# IP searching
requires('Regexp::Common');
diff --git a/html/RTIR/Tools/Elements/GetEmailFromIP b/html/RTIR/Tools/Elements/GetEmailFromIP
index a1e7d2f3..6b8e0a49 100644
--- a/html/RTIR/Tools/Elements/GetEmailFromIP
+++ b/html/RTIR/Tools/Elements/GetEmailFromIP
@@ -62,11 +62,10 @@ unless ( $iterator ) {
$field ||= 'notify';
-my @objects = Net::Whois::Object->new($iterator);
my @res;
-foreach my $obj (@objects) {
- foreach my $attr ( grep lc $_ eq lc $field, $obj->attributes ) {
- push @res, $obj->$attr();
+while ( my $query = $iterator->next ) {
+ foreach my $attr ( grep lc $_ eq lc $field, $query->attributes ) {
+ push @res, $query->$attr();
}
}
unless ( @res ) {
diff --git a/html/RTIR/Tools/Elements/ToolResultsWhois b/html/RTIR/Tools/Elements/ToolResultsWhois
index df664bcf..30d9bae9 100644
--- a/html/RTIR/Tools/Elements/ToolResultsWhois
+++ b/html/RTIR/Tools/Elements/ToolResultsWhois
@@ -59,12 +59,11 @@
<%PERL>
my $DoInvestigate = 0;
if ($WhoisIterator) {
- while ( $WhoisIterator->isnt_exhausted) {
- my $block = $WhoisIterator->value;
- $SavedContent .= $block . "\n";
- my @lines_starting_with_space = grep /^(\s+)(\w+)/, $block;
+ while (my $obj = $WhoisIterator->next) {
+ $SavedContent .= $obj->content . "\n";
+ my @lines_starting_with_space = grep /^(\s+)(\w+)/, $obj->content;
if ($handparse || $#lines_starting_with_space >= 4) { #we couldn't parse that. suck
- my $content = join "", $block;
+ my $content = join "", $obj->content;
$m->comp('/Elements/MakeClicky',
object => $TicketObj,
lookup_params => "ticket=" . ($TicketObj ? $TicketObj->id : 0) . "&server=$WhoisServer",
@@ -75,20 +74,12 @@ if ($WhoisIterator) {
% } else {
Structured RIPE whois data returned.
Click <a href="Lookup.html?q=<% $q |u %>&server=<% $WhoisServer |u %>&handparse=1">here</a> to manually parse this data.
+<br />Warnings <% $obj->warnings %>
+<br />errors <% $obj->errors %>
+<hr />
<%perl>
-my @objects = Net::Whois::Object->new($WhoisIterator);
-foreach my $object ( @objects ) {
- my %seen;
- foreach my $attribute ($object->attributes()) {
- next if ($seen{$attribute});
- $seen{$attribute} = 1;
- my @values;
- foreach my $value ( $object->$attribute() ) {
- next unless ($value);
- push (@values, (ref($value) eq 'ARRAY' ) ? @$value : $value);
- }
- next unless (scalar @values);
- my $value = join("\n", ' ', @values);
+foreach my $attribute ( $obj->attributes ) {
+ foreach my $value ( $obj->$attribute() ) {
</%perl>
<b><%$attribute%></b>:
<& /Elements/MakeClicky,
diff --git a/lib/Net/Whois/RIPE.pm b/lib/Net/Whois/RIPE.pm
new file mode 100644
index 00000000..d01155a8
--- /dev/null
+++ b/lib/Net/Whois/RIPE.pm
@@ -0,0 +1,528 @@
+###############################################################################
+# Net::Whois::RIPE - implementation of RIPE Whois.
+# Copyright (C) 2009 Luis Motta Campos
+# Copyright (C) 2005-2006 Paul Gampe, Kevin Baker
+# vim:tw=78:ts=4
+###############################################################################
+
+package Net::Whois::RIPE;
+
+use strict;
+use Carp;
+use IO::Socket;
+use Net::Whois::RIPE::Object;
+use Net::Whois::RIPE::Object::Template;
+use Net::Whois::RIPE::Iterator;
+
+use constant MAX_RETRY_ATTEMPTS => 3; # number of times to attempt connection
+use constant SLEEP_INTERVAL => 1; # time interval between attempts
+
+our $VERSION = '1.30';
+
+# class wide debug flag 0=off,1=on,2=on for IO::Socket
+my $DEBUG = 0;
+
+# couple of regexs that may need attention
+my $RE_WHOIS = '(?:whois\.apnic\.net)$';
+my $RE_RIPE = '(?:ripe|ra|apnic|afrinic|rr\.arin|6bone)\.net$';
+
+# version string to let whois know which client version it is talking to
+my $VER_FLAG = '-VNWR' . $VERSION;
+
+sub new {
+ my $proto = shift;
+ my ( $host, %arg ) = @_;
+ my $class = ref($proto) || $proto;
+
+ my $debug = exists $arg{Debug} ? $arg{Debug} : 0;
+ unless ($host) {
+ carp "new: no hostname found." if $DEBUG || $debug;
+ return undef;
+ }
+
+ my $self = bless {
+
+ # object fields
+ SOCKET => undef, # unconnected
+ TIMEOUT => $arg{Timeout} || 30, # default timeout
+ MAX_READ_SIZE => 0, # no read size limit
+ DEBUG => $debug, # object debug
+
+ # whois flags
+ FLAG_a => 0, # search all databases
+ FLAG_B => 0, # disable filtering of "notify:", "changed:", "e-mail:
+ FLAG_F => 0, # fast raw output
+ FLAG_g =>
+ 0, # used to sync databases. shouldn't be used for general use
+ FLAG_G => 0, # Disables the grouping of objects by relevance
+ FLAG_h => $host, # host to connect to
+ FLAG_i => '', # do an inverse lookup for specified attributes
+ FLAG_k => 0, # for persistant socket connection
+ FLAG_K => 0, # return only primary keys
+ FLAG_L => 0, # find all Less specific matches
+ FLAG_m => 0, # find first level more specific matches
+ FLAG_M => 0, # find all More specific matches
+ FLAG_p => $arg{Port} || 'whois', # port, usually 43 for whois
+ FLAG_r => 0, # turn off recursive lookups
+ FLAG_R => 0, # do not trigger referral mechanism
+ FLAG_s => '', # search databases with source 'source'
+ FLAG_S => 0, # tell server to leave out 'syntactic sugar'
+ FLAG_t => '', # requests template for object of type 'type'
+ FLAG_T => '', # only look for objects of type 'type'
+ FLAG_v => '', # request verbose template for object of type 'type'
+ FLAG_V => $VER_FLAG, # client Version
+ }, $class;
+
+ # if host matches a server that accepts a
+ # referral IP then add the remote addr to version
+ $self->{FLAG_V} = $VER_FLAG . "," . $ENV{"REMOTE_ADDR"}
+ if $self->{FLAG_h} =~ /$RE_WHOIS/oi
+ and $ENV{"REMOTE_ADDR"};
+
+ # connect to server
+ #unless ($self->_connect) {
+ # carp "new: whois connection failure." if $DEBUG || $debug;
+ # return undef;
+ # }
+ return $self;
+}
+
+sub connect {
+ my $self = shift;
+ $self->_connect();
+}
+
+sub query_iterator {
+ my $self = shift;
+ my $query_key = shift;
+
+ unless ($query_key) {
+ carp "query: no QUERY_KEY found" if $self->debug;
+ return undef;
+ }
+
+ # TODO - close the connection pseudo gracefully if the timeout value
+ # expires. allow user to set timeouts?
+
+ my $sock;
+ unless ( $sock = $self->_connect ) {
+ carp "query: unable to obtain socket" if $self->debug;
+ return undef;
+ }
+
+ my $string;
+ unless ( $string = $self->_options($query_key) ) {
+ carp "query: unable to parse options" if $self->debug;
+ return undef;
+ }
+
+ return Net::Whois::RIPE::Iterator->new( $self, $string . "\n\n" );
+}
+
+sub template {
+ my $self = shift;
+ my $template = shift;
+ unless ($template) {
+ carp "template: no WHOIS OBJECT NAME found" if $self->debug;
+ return wantarray ? () : undef;
+ }
+ $self->{FLAG_t} = 1;
+
+ my $string;
+ unless ( $string = $self->_options($template) ) {
+ carp "template: unable to parse options" if $self->debug;
+ return undef;
+ }
+
+ return $self->_query( $string . "\n\n",
+ "Net::Whois::RIPE::Object::Template" );
+}
+
+sub verbose_template {
+ my $self = shift;
+ my $template = shift;
+ unless ($template) {
+ carp "verbose_template: no WHOIS OBJECT NAME found" if $self->debug;
+ return wantarray ? () : undef;
+ }
+ $self->{FLAG_v} = 1;
+
+ my $string;
+ unless ( $string = $self->_options($template) ) {
+ carp "verbose_template: unable to parse options" if $self->debug;
+ return undef;
+ }
+
+ return $self->_query( $string . "\n\n",
+ "Net::Whois::RIPE::Object::Template" );
+}
+
+sub query {
+ my $self = shift;
+ my $query_key = shift;
+
+ unless ($query_key) {
+ carp "query: no QUERY_KEY found" if $self->debug;
+ return undef;
+ }
+
+ my $string;
+ unless ( $string = $self->_options($query_key) ) {
+ carp "query: unable to parse options" if $self->debug;
+ return undef;
+ }
+
+ if ( $self->{cache} ) {
+ my $object = $self->{cache}->get($string);
+ return wantarray ? @$object : $object->[0] if $object;
+ }
+
+ # TODO - close the connection pseudo gracefully if the timeout value
+ # expires. allow user to set timeouts?
+
+ my $sock;
+ unless ( $sock = $self->_connect ) {
+ carp "query: unable to obtain socket" if $self->debug;
+ return undef;
+ }
+
+ my @object = $self->_query( $string . "\n", "Net::Whois::RIPE::Object" );
+
+ $self->{cache}->set( $string, \@object ) if $self->{cache} and @object;
+
+ return wantarray ? @object : $object[0];
+}
+
+sub update {
+ my $self = shift;
+ my $message = shift;
+
+ unless ($message) {
+ carp 'update: no TEXT message found' if $self->debug;
+ return undef;
+ }
+
+ # pull out login and domain from the changed: line
+ my ( $login, $domain ) = ( $message =~ /changed:\s+(.+)@(.+)\n/ );
+ unless ( $login and $domain ) {
+ carp "update: cannot find 'changed' attribute" if $self->debug;
+ return undef;
+ }
+
+ my $string = $self->{FLAG_V} . " -U $login $domain\n" . $message;
+ return $self->_query( $string, "Net::Whois::RIPE::Object" );
+}
+
+sub _query {
+ my $self = shift;
+ my $string = shift;
+ my $ripe_type = shift;
+
+ my $sock;
+ my @objects;
+ my $connection_attempts = 0;
+
+ while ( $connection_attempts < MAX_RETRY_ATTEMPTS ) {
+
+ unless ( $sock = $self->_connect ) {
+ carp "_query: unable to obtain socket" if $self->debug;
+ return undef;
+ }
+
+ unless ( print $sock $string ) {
+ carp "_query: unable to print to socket:\n$string"
+ if $self->debug;
+ return undef;
+ }
+
+ $sock->flush;
+
+ my $bytes = 0;
+ my $max = $self->max_read_size;
+
+ while ( my $t = $ripe_type->new( $sock, $self->{FLAG_k} ) ) {
+
+ # discards pseudo-records containing only comments
+ next if $self->{FLAG_k} and not $t->attributes and $t->success;
+ if ( $t->size <= 2 ) {
+ return wantarray ? @objects : $objects[0];
+ }
+ push @objects, $t;
+ $bytes += $t->size;
+ if ( $max and $bytes > $max ) {
+ my $msg
+ = "exceeded maximum read size of "
+ . $max
+ . " bytes."
+ . " results may have been truncated.";
+ $t->push_warn($msg);
+ carp "_query: " . $msg if $self->debug;
+ last;
+ }
+ last if $sock->eof or not wantarray;
+ }
+
+ # exit the retry loop unless the client has been disconnected
+ last unless not @objects and $sock->eof;
+
+ carp "_query: disconnected by server "
+ . $self->{FLAG_h}
+ . ", trying again..."
+ if $self->debug;
+ $self->_disconnect;
+ sleep SLEEP_INTERVAL;
+ $connection_attempts++;
+ next;
+ }
+
+ if ( $sock and $self->{FLAG_k} ) {
+ $sock->flush;
+ $self->{SOCKET}->flush;
+ }
+ else {
+ $self->_disconnect;
+ }
+
+ return wantarray ? @objects : $objects[0];
+}
+
+sub max_read_size {
+ my $self = shift;
+ @_ ? $self->{MAX_READ_SIZE} = 0 + shift : $self->{MAX_READ_SIZE};
+}
+
+sub disconnect {
+ $_[0]->_disconnect;
+}
+
+sub cache {
+ return $_[0]->{cache} if not defined $_[1];
+ $_[0]->{cache} = $_[1];
+}
+
+sub search_all { $_[0]->{FLAG_a} = 1 }
+sub fast_raw { $_[0]->{FLAG_F} = 1 }
+sub set_persistance { $_[0]->{FLAG_a} = 1 }
+sub find_less { $_[0]->{FLAG_L} = 1 }
+sub find_more { $_[0]->{FLAG_m} = 1 }
+sub find_all_more { $_[0]->{FLAG_M} = 1 }
+sub no_recursive { $_[0]->{FLAG_r} = 1 }
+sub no_referral { $_[0]->{FLAG_R} = 1 }
+sub no_sugar { $_[0]->{FLAG_S} = 1 }
+sub persistant { $_[0]->{FLAG_k} = 1 }
+sub no_filtering { $_[0]->{FLAG_B} = 1 }
+sub no_grouping { $_[0]->{FLAG_G} = 1 }
+
+# sync is special and is here for completeness. it
+# is not expected that it wil be used
+sub sync { my $self = shift; $self->{FLAG_g} = shift; }
+sub inverse_lookup { my $self = shift; $self->{FLAG_i} = shift; }
+sub primary_only { my $self = shift; $self->{FLAG_K} = shift; }
+sub source { my $self = shift; $self->{FLAG_s} = shift; }
+sub type { my $self = shift; $self->{FLAG_T} = shift; }
+
+sub port {
+ my $self = shift;
+
+ unless ( $self->{FLAG_p} ) {
+ carp 'port: no port defined!' if $self->debug;
+ return undef;
+ }
+
+ # trying to change port? not allowed
+ if (@_) {
+ carp "port: cannot switch port." if $self->debug;
+ }
+ return $self->{FLAG_p};
+}
+
+sub server {
+ my $self = shift;
+
+ unless ( $self->{FLAG_h} ) {
+ carp 'server: no hostname found' if $self->debug;
+ return undef;
+ }
+
+ # trying to change servers? not allowed
+ if (@_) {
+ carp "server: cannot switch server." if $self->debug;
+ }
+ return $self->{FLAG_h};
+}
+
+sub debug {
+ my $self = shift;
+ if (@_) {
+ ref($self) ? $self->{DEBUG} = shift : $DEBUG = shift;
+ }
+ return ref($self) ? ( $DEBUG || $self->{DEBUG} ) : $DEBUG;
+}
+
+sub DESTROY {
+ my $self = shift;
+
+ carp "Destroying ", ref($self) if $self->debug;
+ if ( $self->{SOCKET} and $self->{FLAG_k} ) { # $sock->flush;
+ $self->{SOCKET}->flush;
+ }
+ else {
+ $self->_disconnect;
+ }
+}
+
+END {
+ carp "All Net::Whois::RIPE objects are going away now." if $DEBUG;
+}
+
+###############################################################################
+## P R I V A T E M E T H O D S
+###############################################################################
+
+sub _connect {
+ my $self = shift;
+ if ( $self->{SOCKET} and $self->{SOCKET}->connected ) {
+
+ #carp 'already connected to '.$self->{SOCKET}->peerhost;
+ return $self->{SOCKET};
+ }
+
+ my $sock;
+ my $attempt = 0;
+ my $connected = 0;
+ while ( !$connected and $attempt < MAX_RETRY_ATTEMPTS ) {
+ if ($attempt) {
+ carp "_connect: to server "
+ . $self->{FLAG_h}
+ . " failed, trying again..."
+ if $self->debug;
+ sleep SLEEP_INTERVAL;
+ }
+ $attempt++;
+ $connected = 1
+ if $sock = IO::Socket::INET->new(
+ PeerAddr => $self->server,
+ PeerPort => $self->port,
+ Proto => 'tcp',
+ Timeout => $self->{TIMEOUT}
+ );
+ carp $@ if $@ and $self->debug > 1;
+ }
+ if ( not $connected ) {
+ carp "Failed to connect to host [" . $self->server . "]"
+ if $self->debug;
+ return undef;
+ }
+ $sock->autoflush; # on by default since IO 1.18, but anyhow
+ return $self->{SOCKET} = $sock;
+}
+
+sub _disconnect {
+ my $self = shift;
+ my $sock = $self->{SOCKET};
+ return unless $sock and $sock->connected;
+ $sock->flush; # probably not necessary
+ carp "disconnecting from " . $self->{FLAG_h} if $self->debug;
+ $sock->close;
+ $self->{SOCKET} = undef;
+}
+
+sub _options {
+ my $self = shift;
+ my $key = shift;
+
+ if ( ( !$key )
+ && ( !$self->{FLAG_t} )
+ && ( !$self->{FLAG_g} )
+ && ( !$self->{FLAG_v} )
+ && ( !( ( $self->{FLAG_g} ) && ( $self->{FLAG_t} ) ) ) )
+ {
+ carp '_options: no search key or valid option found' if $self->debug;
+ return undef;
+ }
+
+ if ( !$self->{FLAG_h} ) {
+ carp "_options: no hostname found" if $self->debug;
+ return undef;
+ }
+
+ if ( $self->{FLAG_L} ) {
+ if ( $self->debug ) {
+ carp "_options: warning -L overrides -m\n" if $self->{FLAG_m};
+ carp "_options: warning -L overrides -M\n" if $self->{FLAG_M};
+ }
+ $self->{FLAG_m} = 0;
+ $self->{FLAG_M} = 0;
+ }
+
+ if ( $self->{FLAG_m} ) {
+ if ( $self->debug ) {
+ carp "_options: warning -m overrides -M\n" if $self->{FLAG_M};
+ }
+ $self->{FLAG_M} = 0;
+ }
+
+ my $query = "";
+
+ # tell the server what version of RIPE whois we are running,
+ # but only if we are sure that we are talking to an
+ # RIPE whois server
+
+ if ( ( $self->{FLAG_h} =~ /$RE_RIPE/oi )
+ || $self->{FLAG_a}
+ || $self->{FLAG_B}
+ || $self->{FLAG_g}
+ || $self->{FLAG_G}
+ || $self->{FLAG_F}
+ || $self->{FLAG_i}
+ || $self->{FLAG_k}
+ || $self->{FLAG_K}
+ || $self->{FLAG_m}
+ || $self->{FLAG_M}
+ || $self->{FLAG_R}
+ || $self->{FLAG_L}
+ || $self->{FLAG_r}
+ || $self->{FLAG_s}
+ || $self->{FLAG_S}
+ || $self->{FLAG_t}
+ || $self->{FLAG_v}
+ || $self->{FLAG_T} )
+ {
+
+ $query .= $self->{FLAG_V} . " ";
+ }
+
+ # XXX -g is an undocumented option: get specified updates:
+ # -g Source:First-Last
+ # get updates with 'Source'
+ # from serial 'First' till 'Last' (you may use 'LAST')
+
+ $query .= "-a " if ( $self->{FLAG_a} );
+ $query .= "-B " if ( $self->{FLAG_B} );
+ $query .= "-F " if ( $self->{FLAG_F} );
+ $query .= "-g " . $self->{FLAG_g} . " " if ( $self->{FLAG_g} );
+ $query .= "-G " if ( $self->{FLAG_G} );
+ $query .= "-i " . $self->{FLAG_i} . " " if ( $self->{FLAG_i} );
+ $query .= "-k " if ( $self->{FLAG_k} );
+ $query .= "-K " if ( $self->{FLAG_K} );
+ $query .= "-L " if ( $self->{FLAG_L} );
+ $query .= "-m " if ( $self->{FLAG_m} );
+ $query .= "-M " if ( $self->{FLAG_M} );
+ $query .= "-r " if ( $self->{FLAG_r} );
+ $query .= "-R " if ( $self->{FLAG_R} );
+ $query .= "-S " if ( $self->{FLAG_S} );
+ $query .= "-s " . $self->{FLAG_s} . " " if ( $self->{FLAG_s} );
+ $query .= "-T " . $self->{FLAG_T} . " " if ( $self->{FLAG_T} );
+ $query .= "-t " if ( $self->{FLAG_t} );
+ $query .= "-v " if ( $self->{FLAG_v} );
+
+ $query .= $key;
+
+ carp "_options: parsed query string: $query" if $self->debug;
+
+ return $query;
+}
+
+1;
+__END__
+
diff --git a/lib/Net/Whois/RIPE.pod b/lib/Net/Whois/RIPE.pod
new file mode 100644
index 00000000..62b34a45
--- /dev/null
+++ b/lib/Net/Whois/RIPE.pod
@@ -0,0 +1,254 @@
+=head1 NAME
+
+Net::Whois::RIPE - implementation of RIPE Whois.
+
+=head1 SYNOPSIS
+
+ use Net::Whois::RIPE;
+
+ $whois = Net::Whois::RIPE->new($host);
+ $whois = Net::Whois::RIPE->new($host,Timeout=>10);
+ $whois = Net::Whois::RIPE->new($host,Timeout=>10,Port=>43);
+
+
+ $whois->no_recursive;
+ $whois->source('APNIC');
+ $whois->type('inetnum');
+
+ foreach $inet ($whois->query('203.203.203.203')) {
+ print $inet->inetnum, "\n";
+ }
+
+ $whois->query('202.12.28.0');
+ $whois->update($text);
+
+ # to minimise memory requirements on large lookups...
+ $iterator = $whois->query_iterator('DNS3-AP');
+ while ($obj = $iterator->next) {
+ ...
+ }
+
+ $whois->template('inetnum');
+ $whois->verbose_template('inetnum');
+
+ $whois->debug(1);
+ $whois->max_read_size(1024);
+
+ $whois->search_all; # -a
+ $whois->fast_raw; # -F
+ $whois->find_less; # -L
+ $whois->find_more; # -m
+ $whois->find_all_more; # -M
+ $whois->no_recursive; # -r
+ $whois->no_referral; # -R
+ $whois->no_sugar; # -S
+ $whois->no_filtering; # -B
+ $whois->no_grouping; # -G
+
+ $whois->inverse_lookup($attribute); # -i $attribute
+ $whois->source('APNIC'); # -s APNIC
+ $whois->type('person'); # -T person
+
+ # query only
+
+ $whois->port();
+ $whois->server();
+
+
+=head1 DESCRIPTION
+
+Net::Whois::RIPE class implementing a RIPE whois client.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item B<new (HOST [,OPTIONS])>
+
+This is the constructor for a new Net::Whois::RIPE object. C<HOST> is the
+name of the remote host to which a whois connection is required.
+
+C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
+Possible options are:
+
+ Port - The port number to connect to on the remote machine
+ Timeout - Set a timeout value in seconds (defaults to 30)
+ Debug - See debug methog.
+
+The constructor returns undef on failure. If B<debug> is on then a message
+is carped about the failure.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item B<template(WHOIS_OBJECT_NAME)>
+
+Sends a template request to whois host for a template of WHOIS_OBJECT_NAME.
+Results are returned in a I<Net::Whois::RIPE::Object> object. The template is
+retrieved via the I<content> method on the I<Net::Whois::RIPE::Object> object.
+
+ $t = $whois->template('all');
+ $t = $whois->template('inetnum');
+ $t = $whois->template('person');
+ $text = $t->content;
+
+If WHOIS_OBJECT_NAME is undefined then the method will carp (under debug)
+and return undef.
+
+=item B<verbose_template(WHOIS_OBJECT_NAME)>
+
+Like B<template>, but sends a verbose template request to the whois host for
+WHOIS_OBJECT_NAME. Results are returned in a I<Net::Whois::RIPE::Object> object.
+The verbose template is retrieved via the I<content> method on the
+I<Net::Whois::RIPE::Object> object.
+
+ $vt = $whois->verbose_template('person');
+ $text = $vt->content;
+
+If WHOIS_OBJECT_NAME is undefined then the method will carp and return undef.
+
+=item B<query(QUERY_TEXT)>
+
+Formats query flag options (see below) and sends them and QUERY_TEXT to the
+server. If called in a scalar context then the first object returned from
+the server is passed back as a single I<Net::Whois::RIPE::Object> object.
+In an array context, all returned objects returned from the server are
+parsed into in a list and returned (potentially quite large).
+
+ $q = $whois->query('key') # a single Query
+ @q = $whois->query('key') # an array of Queries
+
+If QUERY_KEY is undefined, undef is returned. Any failure will carp and
+return undef.
+
+If B<max_read_size> is greater than zero then the server response will be
+abandoned when greater than max_read_size bytes have been read. The last
+object read will have warning messages set to indicate that
+the response was cut.
+
+=item B<query_iterator(QUERY_TEXT)>
+
+Similar to I<query> except that a Net::Whois::RIPE::Iterator object is
+returned. This object is used to iterate over the results of the query.
+
+This was created in response to huge results returned by whois queries where
+over 1000 objects may be returned. Query iterator returns an object at a time
+via the I<next> method as opposed to I<query> which returns an array of
+objects.
+
+ $iterator = $whois->query_iterator
+ or die "unable to create iterator";
+ while ($obj = $iterator->next) {
+ ...
+ }
+
+=item B<update(UPDATE_TEXT)>
+
+Sends UPDATE_TEXT directly to server. Query flag options (below) are not used
+by update. Server response is returned via I<Net::Whois::RIPE::Object>. Use the
+B<content> method on the Query object to via server response.
+
+ my $q = $whois->update($message)
+ print $q->content
+
+If UPDATE_TEXT is undefined, undef is returned.
+Any failure will carp and return undef.
+
+If no I<changed> field can be found to determine a login and domain the method
+will carp and return undef.
+
+If B<max_read_size> is greater than zero then the server response will be
+abandoned when greater than max_read_size bytes have been read.
+
+=item B<debug(LEVEL)>
+
+Sets/gets debugging level on the class or an object.
+
+ 0 - no debugging
+ 1 - debugging on
+ 2 - carp on IO::Socket::INET
+
+=item B<max_read_size([INTEGER])>
+
+Sets/reads the maximum number of bytes that I<Net::Whois::RIPE> will
+read before returning. This is to limit huge responses from the server
+overloading scripts.
+
+a I<max_read_size> of zero indicates B<no> limit.
+
+=item B<flag options>
+
+The following flags may be set by calling the method. Their meaning is
+identical to the ripe whois client. These flags require no arguments, they
+simply set the flag on.
+
+ Method Equivalent whois flag
+
+ search_all -a
+ fast_raw -F
+ find_less -L
+ find_more -m
+ find_all_more -M
+ no_recursive -r
+ no_referral -R
+ no_sugar -S
+ no_filtering -B
+ no_grouping -G
+
+=item B<flag options taking values>
+
+The following flags may be set by calling the method with a value.
+There meaning is identical to the ripe whois client.
+
+ Method Equivalent whois flag
+
+ inverse_lookup(ATTRIBUTE) -i ATTRIBUTE
+ port(PORT) -p PORT
+ source(SOURCE) -s SOURCE
+ type(TYPE) -T TYPE
+
+=back
+
+=head1 AUTHOR
+
+ Paul Gampe, <pgampe at users.sourceforge.net>
+ Kevin Baker, <shagol at users.sourceforge.net>
+ Bruce Campbell, <bxc at users.sourceforge.net>
+ Luis Motta Campos E<lt>lmc at cpan.orgE<gt>
+
+=head1 TODO
+
+Update could be made clever enough to determine if it was been passed
+a string to update or a Net::Whois::RIPE::Object and adapt its behaviour.
+
+=head1 SEE ALSO
+
+ Net::Whois::RIPE::Iterator
+ Net::Whois::RIPE::Object
+ Net::Whois::RIPE::Object::Template
+ http://www.ripe.net/db/about.html
+
+=head1 COPYRIGHT
+
+ Copyright (C) 1998 Paul Gampe and APNIC Pty. Ltd.
+ Copyright (C) 2000 Kevin Baker and APNIC Pty. Ltd.
+ Copyright (C) 2004-2005 Paul Gampe
+ Copyright (C) 2009 Luis Motta Campos
+
+ This program is free software; you can redistribute it
+ and/or modify it under the terms of the GNU General Public
+ License as published by the Free Software Foundation;
+ either version 1, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public
+ License along with this program; if not, write to the
+ Free Software Foundation, Inc.,
+ 675 Mass Ave, Cambridge, MA 02139, USA.
diff --git a/lib/Net/Whois/RIPE/Iterator.pm b/lib/Net/Whois/RIPE/Iterator.pm
new file mode 100644
index 00000000..65253c8c
--- /dev/null
+++ b/lib/Net/Whois/RIPE/Iterator.pm
@@ -0,0 +1,90 @@
+###############################################################################
+# Net::Whois::RIPE - implementation of RIPE Whois.
+# Copyright (C) 2009 Luis Motta Campos
+# Copyright (C) 2005 Paul Gampe, Kevin Baker
+# vim:tw=78:ts=4
+###############################################################################
+package Net::Whois::RIPE::Iterator;
+
+use strict;
+use Carp;
+use Net::Whois::RIPE::Object;
+use Net::Whois::RIPE::Object::Template;
+
+our $VERSION = '1.30';
+
+# class wide debug flag 0=off,1=on,2=on for IO::Socket
+my $DEBUG = 0;
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ unless ( @_ == 2 ) {
+ carp "new: expecting Net::Whois::RIPE object and a query string"
+ if $DEBUG;
+ return undef;
+ }
+ my $self = bless {
+ WHOIS => shift,
+ QUERY => shift,
+ DEBUG => 0,
+ }, $class;
+
+ unless ( ref( $self->{WHOIS} ) =~ /^Net::Whois::RIPE$/ ) {
+ carp "new: first parameter must be a Net::Whois::RIPE object"
+ if $DEBUG;
+ return undef;
+ }
+
+ if ( $self->{QUERY} =~ /^\s*$/ ) {
+ carp "new: second parameter must be a whois query string" if $DEBUG;
+ return undef;
+ }
+
+ my $sock = $self->{SOCKET} = $self->{WHOIS}->_connect;
+ unless ( print $sock $self->{QUERY} ) {
+ carp "new: unable to print to socket:\n" . $self->{QUERY} if $DEBUG;
+ return undef;
+ }
+
+ return $self;
+}
+
+sub next {
+ my $self = shift;
+
+ my $sock = $self->{SOCKET};
+ unless ( $sock and $sock->connected ) {
+ carp 'no socket connection' if $DEBUG || $self->debug;
+ return undef;
+ }
+
+ my $obj = Net::Whois::RIPE::Object->new($sock);
+ return $obj if $obj;
+ $self->{WHOIS}->_disconnect();
+ return undef;
+}
+
+sub debug {
+ my $self = shift;
+ if (@_) {
+ ref($self) ? $self->{DEBUG} = shift : $DEBUG = shift;
+ }
+ return ref($self) ? ( $DEBUG || $self->{DEBUG} ) : $DEBUG;
+}
+
+sub DESTROY {
+ my $self = shift;
+ carp "Destroying ", ref($self) if $self->debug;
+}
+
+END {
+ carp "All Net::Whois::RIPE::Iterator objects are going away now."
+ if $DEBUG;
+}
+
+###############################################################################
+## P R I V A T E M E T H O D S
+###############################################################################
+1;
+
diff --git a/lib/Net/Whois/RIPE/Iterator.pod b/lib/Net/Whois/RIPE/Iterator.pod
new file mode 100644
index 00000000..588d4898
--- /dev/null
+++ b/lib/Net/Whois/RIPE/Iterator.pod
@@ -0,0 +1,83 @@
+
+=head1 NAME
+
+Net::Whois::RIPE::Iterator - iterator for RIPE object's.
+
+=head1 SYNOPSIS
+
+ use Net::Whois::RIPE;
+ use Net::Whois::RIPE::Iterator;
+
+ $whois = Net::Whois::RIPE->new($host);
+
+ $iterator = Net::Whois::RIPE::Iterator->new($whois,$query);
+ while ($obj = $iterator->next) {
+ ...
+ }
+
+=head1 DESCRIPTION
+
+Implements an iterator for Net::Whois::RIPE::Objects.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item B<new (WHOIS, QUERY)>
+
+The constructor returns undef on failure. If B<debug> is on then a message
+is carped about the failure.
+
+I<WHOIS> is an object of class I<Net::Whois::RIPE>
+
+I<QUERY> is a query string to be sent to the I<WHOIS> object to
+retrieve the whois objects.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item B<next()>
+
+Returns the next I<Net::Whois::RIPE::Object> from the query.
+
+Returns undef if no more objects.
+
+=item B<debug(LEVEL)>
+
+Sets/gets debugging level on the class or an object.
+
+ 0 - no debugging
+ 1 - debugging on
+
+=back
+
+=head1 AUTHOR
+
+ Kevin Baker, <shagol at users.sourceforge.net>
+
+=head1 SEE ALSO
+
+ Net::Whois::RIPE
+ Net::Whois::RIPE::Object
+
+=head1 COPYRIGHT
+
+ Copyright (C) 2000 Kevin Baker and APNIC Pty. Ltd.
+
+ This program is free software; you can redistribute it
+ and/or modify it under the terms of the GNU General Public
+ License as published by the Free Software Foundation;
+ either version 1, or (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public
+ License along with this program; if not, write to the
+ Free Software Foundation, Inc.,
+ 675 Mass Ave, Cambridge, MA 02139, USA.
diff --git a/lib/Net/Whois/RIPE/Object.pm b/lib/Net/Whois/RIPE/Object.pm
new file mode 100644
index 00000000..cccd4de5
--- /dev/null
+++ b/lib/Net/Whois/RIPE/Object.pm
@@ -0,0 +1,259 @@
+###############################################################################
+# Net::Whois::RIPE - implementation of RIPE Whois.
+# Copyright (C) 2009 Luis Motta Campos
+# Copyright (C) 2005 Paul Gampe, Kevin Baker
+# vim:tw=78:ts=4
+###############################################################################
+package Net::Whois::RIPE::Object;
+use strict;
+use Carp;
+
+our $VERSION = '1.31';
+
+my $errstr = '';
+sub errstr { $errstr }
+
+# XXX: remove declaration of AUTOLOAD from here
+use vars qw($AUTOLOAD);
+
+# values not permitted to be added
+my @NO_ADD = qw(
+ content methods attributes warning error success debug parse
+ size _ok _err _wrn
+);
+my %NO_ADD = map { $_ => 1 } @NO_ADD;
+
+my @Free_Form = qw(descr remarks person address role trouble);
+my %Free_Form = map { $_ => 1 } @Free_Form;
+
+sub new {
+ my $proto = shift;
+ my $class = ref($proto) || $proto;
+ my $handle = shift;
+ my $persistance = shift || 0;
+
+ unless ( $handle and ref($handle) ) {
+ $errstr = 'expected handle not found';
+ carp "expecting a handle";
+ return undef;
+ }
+ $errstr = '';
+
+ my $self = bless {
+ _methods => {}
+ , # storage for parsed attributes values, lookup by attribute
+ _order => [], # order attributes are saved in
+ _content => [], # untampered text from whois server
+ _debug => 0, # off by default
+ _warn => [],
+ _error => [],
+ }, $class;
+
+ return $self->parse( $handle, $persistance ) ? $self : undef;
+}
+
+sub parse {
+ my $self = shift;
+ my $handle = shift;
+ my $persistance = shift;
+
+ my $found_record = 0;
+ my $precedent_attribute;
+ local $/ = "\n";
+ local $_;
+
+ my $line_cnt = 0;
+ while ( $_ = <$handle> ) { # walk through the response
+ $line_cnt++;
+ push @{ $self->{_content} }, $_; # save the entire response
+
+ if ( $self->debug ) {
+ my $received = $_;
+ chomp $received;
+ carp "received ->", $received;
+ }
+
+ /^The object shown below is NOT in the/ and $self->_err($_);
+ /^\%\s+No entries found/ and $self->_err('No entries found');
+ /^\%ERROR:(.*)/ and $self->_err($1), next;
+ /^%/ and next; # skip server comments
+ /^\n$/ and $found_record and last;
+ /^\n$/ and $persistance and last;
+ /^\n$/ and next;
+
+ chomp;
+
+ # search for errors, failures and warnings
+ /^(?:New|Delete|Update) FAILED/ and next; # followed by ERROR
+ /^(?:New|Update|Delete) OK:(.*)/ and $self->_ok($1), next;
+ /^\*ERROR\*:\s+(.*)/ and $self->_err($1), next;
+ /^WARNING:\s+(.*)/ and $self->_wrn($1), next;
+
+ # ok, now try to match attribute value pairs
+ if ( my ($value) = /^(\+\s*.*|\s+.+)$/ and $precedent_attribute ) {
+ $value =~ s/^\+/ /;
+ $self->clean_and_add( $precedent_attribute, $value );
+ }
+ elsif ( my ( $attribute, $v ) = /^([\w\-]+|\*\w\w):\s*(.*)$/ ) {
+ $self->clean_and_add( $attribute, $v );
+ $precedent_attribute = $attribute;
+ $found_record = 1;
+ }
+ else {
+ $self->_err("unparseable line: '$_'");
+ }
+ }
+
+ if ( $line_cnt == 0 ) {
+ carp "parse: no lines read from handle" if $self->debug;
+ $errstr = "no lines read from handle";
+ return 0;
+ }
+
+ if ( @{ $self->{_content} } == 0 ) { # this should be caught by $line_cnt
+ carp "parse: no content read from handle" if $self->debug;
+ $errstr = "no content read from handle";
+ return 0;
+ }
+
+ if ( scalar $self->content =~ /^\s*$/ ) {
+ carp "parse: content is all whitespace" if $self->debug;
+ $errstr = "content is all whitespace";
+ return 0;
+ }
+
+ return 1;
+}
+
+sub size { # will only work in the ascii world
+ my $self = shift;
+ return length scalar $self->content;
+}
+
+sub clean_and_add {
+ my ( $self, $attr, $value ) = @_;
+
+ # strip end of line comments and leading and trailing white space
+ $value =~ s/#.*$// unless exists $Free_Form{$attr};
+ $value =~ s/^\s+//;
+ $value =~ s/\s+$//;
+
+ return $self->add( $attr, $value );
+}
+
+sub add {
+ my ( $self, $attr, $value ) = @_;
+
+ unless ( ref($self) and $attr and defined $value ) {
+ carp "add: expecting an ATTRIBUTE and a VALUE" if $self->debug;
+ return undef;
+ }
+
+ # don't clobber our method names
+ if ( defined $NO_ADD{$attr} ) {
+ carp "attribute [$attr] is a reserved attribute" if $self->debug;
+ return undef;
+ }
+
+ carp "adding attribute [$attr] with value [$value]" if $self->debug;
+
+ # preserve order in which the attributes are registered.
+ # if this ATTRIBUTE has been saved before then do not
+ # place it on the order list again.
+ push @{ $self->{_order} }, $attr
+ unless exists $self->{_methods}->{$attr};
+
+ # save the VALUE on the list for that ATTRIBUTE
+ push @{ $self->{_methods}->{$attr} }, $value;
+}
+
+sub content {
+ my $self = shift;
+ return wantarray
+ ? @{ $self->{_content} }
+ : join( '', @{ $self->{_content} } );
+}
+
+sub methods { return $_[0]->attributes }
+
+sub attributes {
+ my $self = shift;
+ return @{ $self->{_order} };
+}
+
+sub warning {
+ my $self = shift;
+
+ # local $^W=0;
+ return wantarray ? @{ $self->{_warn} } : join( "\n", @{ $self->{_warn} } );
+}
+
+sub error {
+ my $self = shift;
+
+ # local $^W=0;
+ return
+ wantarray ? @{ $self->{_error} } : join( "\n", @{ $self->{_error} } );
+}
+
+sub success {
+ my $self = shift;
+ return @{ $self->{_error} } ? 0 : 1;
+}
+
+sub debug {
+ my $self = shift;
+ return @_ ? $self->{_debug} = shift : $self->{_debug};
+}
+
+sub AUTOLOAD {
+ my $self = shift;
+ my $type = ref($self) or croak "$self is not an object";
+
+ my $name = $AUTOLOAD;
+ $name =~ s/^.*://; # strip fully-qualified portion
+ $name =~ s/_/-/g; # change _ to - in method name: same as 'add'
+
+ unless ( exists $self->{_methods}->{$name} ) {
+ carp "I don't know about method `$name' in class $type"
+ if $self->debug;
+ return undef;
+ }
+
+ # all the attribute values are stored in arrays
+ return wantarray
+ ? @{ $self->{_methods}->{$name} }
+ : $self->{_methods}->{$name}->[0];
+}
+
+sub DESTROY { }
+
+###############################################################################
+## P R I V A T E M E T H O D S
+###############################################################################
+
+sub _err { my $self = shift; (@_) and push @{ $self->{_error} }, shift }
+sub push_warn { shift->_wrn(@_) }
+sub _wrn { my $self = shift; (@_) and push @{ $self->{_warn} }, shift }
+
+sub _ok {
+ my ( $self, $text ) = @_;
+ unless ($text) {
+ carp "_ok: can't find TEXT" if $self->debug;
+ return undef;
+ }
+
+ # New and Update return the nic hdl of the created/updated object
+ # tear out the nic-hdl from the text. example text below.
+ #New OK: [person] KB1-TEST (Kevin Baker)
+ #Update OK: [person] KB1-TEST (Kevin Baker)
+ # I made this a separate routine in case there turn out to be other
+ # cases to match. For instance, a route object.
+ if ( $text =~ /\[person\]\s+([^\s]+)\s+\((.+)\)/ ) {
+ $self->add( 'nic-hdl', $1 );
+ $self->add( 'person', $2 );
+ }
+}
+
+1;
+__END__
diff --git a/lib/Net/Whois/RIPE/Object.pod b/lib/Net/Whois/RIPE/Object.pod
new file mode 100644
index 00000000..ed77b920
--- /dev/null
+++ b/lib/Net/Whois/RIPE/Object.pod
@@ -0,0 +1,172 @@
+=head1 NAME
+
+Net::Whois::RIPE::Object - RIPE Query Results
+
+=head1 SYNOPSIS
+
+ use Net::Whois::RIPE::Object;
+
+
+ $object = new Net::Whois::RIPE::Object;
+ $object->debug(1);
+
+
+ while ($line = $whois_socket->get()) {
+ ($attribute,$value) = ($line =~ /^(.+?):\s+(.+)$/);
+ next unless $attribute;
+ $object->add($attribute,$value);
+ }
+
+ $object->success || die;
+
+ foreach $attribute ($object->attributes()) {
+ foreach $value ($object->$attribute()) {
+ printf "%s: %-s\n", $attribute, $value;
+ }
+ }
+
+ print $object->content; # raw content from whois server
+
+ for $error ($object->error) {...}
+ for $warn ($object->warning) {...}
+
+=head1 DESCRIPTION
+
+Encapsulates the results of a whois query. The attribute/value pairs
+of the response may then by accessed using the attribute as a method
+name.
+
+These objects are created by I<Net::Whois::RIPE> to be
+returned as I<query> results.
+
+Short background...a B<whois> server would return the following for a person
+query.
+
+ person: Paul Gampe
+ address: Level 1 - 33 Park Road
+ address: Milton, QLD, 4064
+ country: AU
+ phone: +61-7-3367-0490
+ fax-no: +61-7-3367-0482
+ e-mail: paulg at apnic.net
+ nic-hdl: PG6-AP
+ remarks: APNIC Technical Operations Team
+ mnt-by: MAINT-AP-APNIC-TECH
+ changed: paulg at apnic.net 19990909
+ source: APNIC
+
+I<Net::Whois::RIPE::Object> parses the attribute's and values and B<add>'s
+them to itself. The RIPE object can then be used to access the attribute
+values using the attribute names as methods. A call to B<attributes> returns
+an ordered list of all attributes parsed.
+
+All values are stored as lists since some attributes are multiline
+(e.g. address). If there has been a problem with the query then the B<content>
+method may provide output from the server that can be used to diagnose why.
+
+ $whois = Net::Whois::RIPE->new($host);
+ $query = $whois->query('Paul Gampe');
+
+ unless ($query->success) {
+ print "There's been a problem...server response is...\n";
+ print $query->content;
+ exit
+ }
+
+ print "Paul's nic-hdl is ", $query->nic_hdl, "\n";
+
+Attributes that had a dash '-' are converted to underscore '_' for method names.
+
+=head1 CONSTRUCTOR
+
+=over 4
+
+=item B<new(HANDLE)>
+
+Creates a new RIPE object. Attempts to parse lines from I<HANDLE>. Any
+parsing failure causes the constructor to return undef. Error messages are
+available via B<errstr>. I<HANDLE> may be a file handle or a socket.
+
+=back
+
+=head1 METHODS
+
+=over 4
+
+=item B<content()>
+
+Returns the raw output from the whois server. In a list context it
+returns the lines from whois as a list. In a scalar context it returns
+the entire list in a scalar.
+
+In the case where no ATTRIBUTE's are available via the B<attributes> method,
+then the content may hold information from I<whois> as to why.
+
+=item B<attributes()>
+
+Returns the list of ATTRIBUTE's that were added by B<add>.
+The order of the list is the order the ATTRIBUTE's were added in.
+
+If no ATTRIBUTE's were added then an empty list is returned. Try calling
+B<content> to obtain output from the I<whois> server as to why.
+
+Call I<attributes> to find out if the object was successfully parsed.
+I<success> reports errors from the whois server. It is possible that
+I<success> can report true but the object has no attributes.
+
+=item B<warning()>
+
+In a list context it returns an array of warning lines. In a scalar
+context it returns a \n separated string of warning lines.
+
+These are the warnings from the whois server about the object.
+
+=item B<error()>
+
+In a list context it returns an array of error lines. In a scalar
+context it returns a \n separated string of error lines.
+
+These are the errors from the whois server about the object.
+
+=item B<success>
+
+Returns 1 if no errors defined, 0 otherwise
+
+=item B<debug(LEVEL)>
+
+Sets/gets the debug level.
+
+=back
+
+=head1 CAVEATS
+
+=head1 AUTHOR
+
+ Kevin Baker, <shagol at users.sourceforge.net>
+ Paul Gampe, <pgampe at users.sourceforge.net>
+ Bruce Campbell, <bxc at users.sourceforge.net>
+ Luis Motta Campos, E<lt>lmc at cpan.orgE<gt>
+
+=head1 SEE ALSO
+
+ Net::Whois::RIPE
+
+=head1 COPYRIGHT
+
+ Copyright (C) 1999 Paul Gampe and APNIC Pty. Ltd.
+ Copyright (C) 2000 Kevin Baker and APNIC Pty. Ltd.
+ Copyright (C) 2009 Luis Motta Campos
+
+ This program is free software; you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation; either version 1, or (at your option)
+ any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program; if not, write to the Free Software
+ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
diff --git a/lib/Net/Whois/RIPE/Object/Template.pm b/lib/Net/Whois/RIPE/Object/Template.pm
new file mode 100644
index 00000000..cf55d3ce
--- /dev/null
+++ b/lib/Net/Whois/RIPE/Object/Template.pm
@@ -0,0 +1,83 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2018 Best Practical Solutions, LLC
+# <sales at bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+
+package Net::Whois::RIPE::Object::Template;
+use strict;
+use Carp;
+
+our $VERSION = '1.30';
+
+our @ISA = qw(Net::Whois::RIPE::Object);
+
+sub parse {
+ my $self = shift;
+ my $handle = shift;
+
+ local $/ = "\n"; # record separator
+
+ my $not_a_template = 0;
+ while ( $_ = <$handle> ) { # walk through the response
+ push @{ $self->{_content} }, $_; # save the entire response
+ next if $not_a_template;
+
+ if (/^% (No (?:verbose )?template available for object .+$)/) {
+ $not_a_template = 1;
+ $self->__error($1);
+ next;
+ }
+
+ chomp;
+ my ( $attr, $value );
+ next unless ( ( $attr, $value ) = /^([\w\-]+|\*\w\w):\s+(.*)$/ );
+ $self->add( $attr, $value ) if $attr;
+ }
+
+ return ( scalar $self->content ) !~ /^\s*$/;
+}
+1;
+__END__
diff --git a/lib/RT/IR.pm b/lib/RT/IR.pm
index 01f813d6..1d4c03f4 100644
--- a/lib/RT/IR.pm
+++ b/lib/RT/IR.pm
@@ -686,10 +686,9 @@ sub WhoisLookup {
last;
}
}
-
- my $whois = Net::Whois::RIPE->new( hostname => $host, port => $port, recursive => 1 );
+ my $whois = Net::Whois::RIPE->new( $host, Port => $port, Debug => $debug || 0 );
my $iterator;
- $iterator = $whois->query( $args{'Query'} )
+ $iterator = $whois->query_iterator( $args{'Query'} )
if $whois;
return (undef, $args{'CurrentUser'}->loc("Unable to connect to WHOIS server '[_1]'", $server) )
unless $iterator;
-----------------------------------------------------------------------
More information about the rt-commit
mailing list