[Rt-commit] rtir branch, 5.0/fix-net-whois-test-functionality, created. 4.0.1rc1-199-g828575c7

[Aaron Trevena]

The branch, 5.0/fix-net-whois-test-functionality has been created
        at  828575c71c121c8f5b11fb41ede2c10fbf674a8b (commit)

- Log -----------------------------------------------------------------
commit 828575c71c121c8f5b11fb41ede2c10fbf674a8b
Author: Aaron Trevena <ast at bestpractical.com>
Date:   Fri Jun 12 11:43:45 2020 +0100

    Fix whois lookup by ip address with new Net::WHOIS::RIPE
    
    Remove/Replace Net::Whois::Object calling code.
    
    Net::Whois::Object can't parse most responses from whois servers and will throw
    fatal errors for normal responses, it's simpler and more reliable to just parse
    ourselves.
    
    Removed code using Net::Whois::Object that was very rarely called as the hand-parse
    check was pretty much always returning true.

diff --git a/html/RTIR/Tools/Elements/GetEmailFromIP b/html/RTIR/Tools/Elements/GetEmailFromIP
index 0d768be7..1e1d1f1c 100644
--- a/html/RTIR/Tools/Elements/GetEmailFromIP
+++ b/html/RTIR/Tools/Elements/GetEmailFromIP
@@ -62,13 +62,21 @@ 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();
+my @res = ( );
+while ( ! $iterator->is_exhausted() ) {
+    foreach my $line ( split /\n/, $iterator->value() ) {
+        # Parse simple "Field: Value" lines in response, ignoring spaces at start
+        # as Net::Whois::Object can't parse and fails with a fatal error
+        if ( $line =~ /^\s*(\S+\s?\S*):\s*(.*)/ ) {
+            my ($attribute, $value) = ($1,$2);
+            next unless (defined($attribute) && $attribute);
+            if (lc $attribute eq lc $field) {
+                push(@res, $value);
+            }
+        }
     }
 }
+
 unless ( @res ) {
     $$error = loc("Whois server response did not include field '[_1]'", $field);
     return;
diff --git a/html/RTIR/Tools/Elements/ToolResultsWhois b/html/RTIR/Tools/Elements/ToolResultsWhois
index 9e7110d3..c178671c 100644
--- a/html/RTIR/Tools/Elements/ToolResultsWhois
+++ b/html/RTIR/Tools/Elements/ToolResultsWhois
@@ -62,48 +62,16 @@ if ($WhoisIterator) {
     while ( $WhoisIterator->isnt_exhausted) {
         my $block = $WhoisIterator->value;
         $SavedContent .= $block . "\n";
-        my @lines_starting_with_space = grep /^(\s+)(\w+)/, $block;
-        if ($handparse || $#lines_starting_with_space >= 4) {    #we couldn't parse that. suck
-            my $content = join "", $block;
-            $m->comp('/Elements/MakeClicky',
-                     object        => $TicketObj,
-                     lookup_params => "ticket=" . ($TicketObj ? $TicketObj->id : 0) . "&server=$WhoisServer",
-                     content       => \$content,);
-            $DoInvestigate = 1 if $content =~ /Requestorbox/ig;
+        my $content = join "", $block;
+        $m->comp('/Elements/MakeClicky',
+                 object        => $TicketObj,
+                 lookup_params => "ticket=" . ($TicketObj ? $TicketObj->id : 0) . "&server=$WhoisServer",
+                 content       => \$content,);
+        $DoInvestigate = 1 if $content =~ /Requestorbox/ig;
 </%PERL>
 <pre><% $content |n %></pre><br />
-%       } 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.
-<%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);
-</%perl>
-     <b><%$attribute%></b>: 
-<& /Elements/MakeClicky, 
-    ticket => $TicketObj, 
-    lookup_params => "ticket=".$TicketObj->id, 
-    content => \$value &>
-<% $value |n %><br />
-<%perl>
-     }
-   }
-
-  }
- }
- }
-</%perl>
+%  }
+%}
 %# Don't offer the option of Investigating to unless there are addresses
 % if ( $DoInvestigate ) {
 <& /Elements/Submit,

-----------------------------------------------------------------------