[Rt-commit] rtir branch, 5.0/extract-domain, created. 4.0.1rc1-215-g58904589

? sunnavy sunnavy at bestpractical.com
Fri Jun 12 16:47:34 EDT 2020


The branch, 5.0/extract-domain has been created
        at  589045892a8006edce0170c5f78c26962208708f (commit)

- Log -----------------------------------------------------------------
commit c21133a7eb0c1cd6dd68c1959185f202a0946981
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Tue Jun 26 15:46:44 2018 +0800

    Extract domains to custom field Domain
    
    The behavior is quite similar to IP

diff --git a/META.yml b/META.yml
index 9901c2f7..82722412 100644
--- a/META.yml
+++ b/META.yml
@@ -27,9 +27,10 @@ no_index:
     - t
 requires:
   DBIx::SearchBuilder: 1.61
+  Net::Domain::TLD: 0
+  Net::Whois::RIPE: 2.006001
   Parse::BooleanLogic: 0
   Regexp::Common: 0
-  Net::Whois::RIPE: 2.006001
   perl: 5.10.1
 resources:
   license: http://opensource.org/licenses/gpl-license.php
diff --git a/Makefile.PL b/Makefile.PL
index 12c0f058..5ae905fd 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -32,6 +32,9 @@ requires('Regexp::Common');
 # queries parsing
 requires('Parse::BooleanLogic');
 
+# Domain searching
+requires('Net::Domain::TLD');
+
 # for tests
 build_requires('Test::More');
 build_requires('File::Find');
diff --git a/etc/RTIR_Config.pm b/etc/RTIR_Config.pm
index ef7f2e36..e3e9b52a 100644
--- a/etc/RTIR_Config.pm
+++ b/etc/RTIR_Config.pm
@@ -641,7 +641,7 @@ available in all screens in RTIR so may not be the best place for Custom Fields.
 
 Set(%CustomFieldGroupings,
     'RTIR::Ticket' => [
-        'Networking'     => ['IP'],
+        'Networking'     => ['IP', 'Domain'],
         'Details' => ['How Reported','Reporter Type','Customer',
                       'Description', 'Resolution', 'Function', 'Classification',
                       'Customer',
@@ -649,6 +649,16 @@ Set(%CustomFieldGroupings,
     ],
 );
 
+=item C<$RTIR_StrictDomainTLD>
+
+If true then RTIR will check if TLD is officially valid on domain
+extraction. Set it to 0 if you need to support local TLDs or recent ones
+that are not included in L<Net::Domain::TLD> yet. It's true by default.
+
+=cut
+
+Set($RTIR_StrictDomainTLD, 1);
+
 =back
 
 =head1 Countermeasures
diff --git a/etc/initialdata b/etc/initialdata
index 9eb62c56..277fe1f6 100644
--- a/etc/initialdata
+++ b/etc/initialdata
@@ -157,6 +157,15 @@ die "Please add RT::IR to your Plugins configuration before initializing the dat
         Values      => [],
         Description => 'Customer for Investigations RTIR queue',
     },
+    {
+        Name        => 'Domain',
+        Type        => 'FreeformMultiple',
+        Queue       => [ 'Incidents', 'Incident Reports', 'Investigations', 'Countermeasures' ],
+        Disabled    => 0,
+        Description => 'Domain for RTIR queues',
+        LinkValueTo =>
+            '__WebPath__/RTIR/Tools/Lookup.html?type=host&q=__CustomField__&ticket=__id__'
+    },
 );
 
 @ScripActions = (
@@ -208,7 +217,15 @@ die "Please add RT::IR to your Plugins configuration before initializing the dat
         Description =>
             'Move all tickets related to an incident to a new constituency',
         ExecModule => 'RTIR_ChangeChildConstituencies'
-    }
+    },
+    {   Name        => 'RTIR parse message for Domains',                 # loc
+        Description => 'Set Domain custom field from message content',   # loc
+        ExecModule  => 'RTIR_FindDomain',
+    },
+    {   Name        => 'RTIR merge Domains',                                 # loc
+        Description => 'Merge multiple Domains on ticket merge',             # loc
+        ExecModule  => 'RTIR_MergeDomains',
+    },
 );
 
 @ScripConditions = (
@@ -371,6 +388,34 @@ die "Please add RT::IR to your Plugins configuration before initializing the dat
         Template       => 'Blank'
     },
 
+    {
+        Description    => "SetDomainFromContent",
+        Queue          => [ 'Incidents', 'Incident Reports', 'Investigations', 'Countermeasures' ],
+        ScripCondition => 'On Correspond',
+        ScripAction    => 'RTIR parse message for Domains',
+        Template       => 'Blank'
+    },
+    {
+        Description    => "SetDomainFromContent",
+        Queue          => [ 'Incidents', 'Incident Reports', 'Investigations', 'Countermeasures' ],
+        ScripCondition => 'On Create',
+        ScripAction    => 'RTIR parse message for Domains',
+        Template       => 'Blank'
+    },
+    {   Description => "MergeDomains",
+        Queue =>
+            [ 'Incidents', 'Incident Reports', 'Investigations', 'Countermeasures' ],
+        ScripCondition => 'RTIR Merge',
+        ScripAction    => 'RTIR merge Domains',
+        Template       => 'Blank'
+    },
+    {   Description    => "On Linking To Incident Copy Domains",
+        Queue          => 'Incident Reports',
+        ScripCondition => 'RTIR Linking To Incident',
+        ScripAction    => 'RTIR merge Domains',
+        Template       => 'Blank'
+    },
+
 );
 
 # WARNING: If you change content of the templates, don't forget to
diff --git a/etc/upgrade/4.9.0/content b/etc/upgrade/4.9.0/content
new file mode 100644
index 00000000..01fd3c47
--- /dev/null
+++ b/etc/upgrade/4.9.0/content
@@ -0,0 +1,56 @@
+use strict;
+use warnings;
+
+our @CustomFields = (
+    {
+        Name        => 'Domain',
+        Type        => 'FreeformMultiple',
+        Queue       => [ 'Incidents', 'Incident Reports', 'Investigations', 'Countermeasures' ],
+        Disabled    => 0,
+        Description => 'Domain for RTIR queues',
+        LinkValueTo =>
+            '__WebPath__/RTIR/Tools/Lookup.html?type=host&q=__CustomField__&ticket=__id__'
+    },
+);
+
+our @ScripActions = (
+    {
+        Name        => 'RTIR parse message for Domains',
+        Description => 'Set Domain custom field from message content',
+        ExecModule  => 'RTIR_FindDomain',
+    },
+    {   Name        => 'RTIR merge Domains',                                 # loc
+        Description => 'Merge multiple Domains on ticket merge',             # loc
+        ExecModule  => 'RTIR_MergeDomains',
+    },
+);
+
+our @Scrips = (
+    {
+        Description    => "SetDomainFromContent",
+        Queue          => [ 'Incidents', 'Incident Reports', 'Investigations', 'Countermeasures' ],
+        ScripCondition => 'On Correspond',
+        ScripAction    => 'RTIR parse message for Domains',
+        Template       => 'Blank'
+    },
+    {
+        Description    => "SetDomainFromContent",
+        Queue          => [ 'Incidents', 'Incident Reports', 'Investigations', 'Countermeasures' ],
+        ScripCondition => 'On Create',
+        ScripAction    => 'RTIR parse message for Domains',
+        Template       => 'Blank'
+    },
+    {   Description => "MergeDomains",
+        Queue =>
+            [ 'Incidents', 'Incident Reports', 'Investigations', 'Countermeasures' ],
+        ScripCondition => 'RTIR Merge',
+        ScripAction    => 'RTIR merge Domains',
+        Template       => 'Blank'
+    },
+    {   Description    => "On Linking To Incident Copy Domains",
+        Queue          => 'Incident Reports',
+        ScripCondition => 'RTIR Linking To Incident',
+        ScripAction    => 'RTIR merge Domains',
+        Template       => 'Blank'
+    },
+);
diff --git a/lib/RT/Action/RTIR_FindDomain.pm b/lib/RT/Action/RTIR_FindDomain.pm
new file mode 100644
index 00000000..424c4447
--- /dev/null
+++ b/lib/RT/Action/RTIR_FindDomain.pm
@@ -0,0 +1,122 @@
+# 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 }}}
+
+use strict;
+use warnings;
+
+package RT::Action::RTIR_FindDomain;
+use base qw(RT::Action::RTIR);
+
+# See Regular Expressions Cookbook, 2nd Edition: 8.15. Validating Domain Names
+my $regex = qr/\b((?:(?=[a-z0-9-]{1,63}\.)(?:xn--)?[a-z0-9]+(?:-[a-z0-9]+)*\.)+([a-z]{2,63}))\b/;
+
+=head2 Commit
+
+Search for domains in the transaction's content.
+
+=cut
+
+sub Commit {
+    my $self   = shift;
+    my $ticket = $self->TicketObj;
+
+    my $cf = $ticket->LoadCustomFieldByIdentifier( 'Domain' );
+    return 1 unless $cf && $cf->id;
+
+    my $attach = $self->TransactionObj->ContentObj;
+    return 1 unless $attach && $attach->id;
+
+    my %existing;
+    for ( @{ $cf->ValuesForObject( $ticket )->ItemsArrayRef } ) {
+        $existing{ $_->Content } = 1;
+    }
+
+    my $how_many_can = $cf->MaxValues;
+    if ( $how_many_can && $how_many_can <= keys %existing ) {
+        RT->Logger->debug( "Ticket #" . $ticket->id . " already has maximum number of Domains, skipping" );
+        return 1;
+    }
+
+    my $content = $attach->Content || '';
+    while ( $content =~ m/$regex/igo ) {
+        my $domain = $1;
+        my $tld    = $2;
+
+        next unless length $domain <= 253;
+        if ( RT->Config->Get('RTIR_StrictDomainTLD') ) {
+            require Net::Domain::TLD;
+            next unless Net::Domain::TLD::tld_exists($tld);
+        }
+
+        $self->AddDomain(
+            Domain      => $domain,
+            CustomField => $cf,
+            Skip        => \%existing,
+        );
+    }
+
+    return 1;
+}
+
+sub AddDomain {
+    my $self = shift;
+    my %arg = ( CustomField => undef, Domain => undef, Skip => {}, @_ );
+    return 0 if !$arg{'Domain'} || $arg{'Skip'}->{ $arg{'Domain'} }++;
+
+    my ( $status, $msg ) = $self->TicketObj->AddCustomFieldValue(
+        Value => $arg{'Domain'},
+        Field => $arg{'CustomField'},
+    );
+    RT->Logger->error( "Couldn't add Domain: $msg" ) unless $status;
+
+    return 1;
+}
+
+RT::IR->ImportOverlays;
+
+1;
diff --git a/lib/RT/Action/RTIR_MergeDomains.pm b/lib/RT/Action/RTIR_MergeDomains.pm
new file mode 100644
index 00000000..5e844278
--- /dev/null
+++ b/lib/RT/Action/RTIR_MergeDomains.pm
@@ -0,0 +1,85 @@
+# 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 RT::Action::RTIR_MergeDomains;
+use strict;
+use warnings;
+use base 'RT::Action::RTIR';
+
+=head2 Commit
+
+Copy Domains from one ticket to another
+
+=cut
+
+sub Commit {
+    my $self = shift;
+
+    my $txn = $self->TransactionObj;
+    my $uri = $txn->NewValue or return 1;
+
+    my $uri_obj = RT::URI->new( $self->CurrentUser );
+    my ($status) = $uri_obj->FromURI( $uri );
+    unless ( $status && $uri_obj->Resolver && $uri_obj->Scheme ) {
+        RT->Logger->error( "Couldn't resolve '$uri' into a URI." );
+        return 1;
+    }
+
+    my $target = $uri_obj->Object;
+    return 1 if $target->id eq $txn->ObjectId;
+
+    my $source = RT::Ticket->new( $self->CurrentUser );
+    $source->LoadById( $txn->ObjectId );
+
+    return $self->CopyCustomFields( To => $target, From => $source, CF => 'Domain' );
+
+}
+
+RT::IR->ImportOverlays;
+
+1;

commit 589045892a8006edce0170c5f78c26962208708f
Author: sunnavy <sunnavy at bestpractical.com>
Date:   Fri Jun 29 04:27:19 2018 +0800

    Test domain extraction

diff --git a/t/custom-fields/domain.t b/t/custom-fields/domain.t
new file mode 100644
index 00000000..a5ccbf82
--- /dev/null
+++ b/t/custom-fields/domain.t
@@ -0,0 +1,301 @@
+#!/usr/bin/perl
+
+use strict;
+use warnings;
+
+use RT::IR::Test tests => undef;
+
+RT::Test->started_ok;
+my $agent = default_agent();
+
+my $cf;
+diag "load and check basic properties of the Domain CF";
+{
+    my $cfs = RT::CustomFields->new( $RT::SystemUser );
+    $cfs->Limit( FIELD => 'Name', VALUE => 'Domain', CASESENSITIVE => 0 );
+    is( $cfs->Count, 1, "found one CF with name 'Domain'" );
+
+    $cf = $cfs->First;
+    is( $cf->Type,       'Freeform',             'type check' );
+    is( $cf->LookupType, 'RT::Queue-RT::Ticket', 'lookup type check' );
+    ok( !$cf->MaxValues, "unlimited number of values" );
+    ok( !$cf->Disabled,  "not disabled" );
+}
+
+diag "check that CF applies to all RTIR's queues";
+{
+    foreach ( 'Incidents', 'Incident Reports', 'Investigations', 'Countermeasures' ) {
+        my $queue = RT::Queue->new( $RT::SystemUser );
+        $queue->Load( $_ );
+        ok( $queue->id, 'loaded queue ' . $_ );
+        my $cfs = $queue->TicketCustomFields;
+        $cfs->Limit( FIELD => 'id', VALUE => $cf->id, ENTRYAGGREGATOR => 'AND' );
+        is( $cfs->Count, 1, 'field applies to queue' );
+    }
+}
+
+my $rtir_user = RT::CurrentUser->new( rtir_user() );
+
+diag "create a ticket via web and set Domain";
+{
+    my $i = 0;
+    my $incident_id;    # countermeasure couldn't be created without incident id
+    foreach my $queue ( 'Incidents', 'Incident Reports', 'Investigations', 'Countermeasures' ) {
+        diag "create a ticket in the '$queue' queue";
+
+        my $val = ++$i . '.example.com';
+        my $id  = $agent->create_rtir_ticket_ok(
+            $queue,
+            { Subject => "test domain", ( $queue eq 'Countermeasures' ? ( Incident => $incident_id ) : () ), },
+            { Domain => $val },
+        );
+        $incident_id = $id if $queue eq 'Incidents';
+
+        $agent->content_like( qr/\Q$val/, "Domain on the page" );
+
+        my $ticket = RT::Ticket->new( $RT::SystemUser );
+        $ticket->Load( $id );
+        ok( $ticket->id, 'loaded ticket' );
+        is( $ticket->FirstCustomFieldValue( 'Domain' ), $val, 'correct value' );
+    }
+}
+
+diag "create a ticket via web with Domain in message";
+{
+    my $i = 0;
+    my $incident_id;    # countermeasure couldn't be created without incident id
+    foreach my $queue ( 'Incidents', 'Incident Reports', 'Investigations', 'Countermeasures' ) {
+        diag "create a ticket in the '$queue' queue";
+
+        my $val = ++$i . '.example.com';
+        my $id  = $agent->create_rtir_ticket_ok(
+            $queue,
+            {
+                Subject => "test domain in message",
+                ( $queue eq 'Countermeasures' ? ( Incident => $incident_id ) : () ), Content => "$val",
+            },
+        );
+        $incident_id = $id if $queue eq 'Incidents';
+
+        $agent->content_like( qr/\Q$val/, "Domain on the page" );
+
+        my $ticket = RT::Ticket->new( $RT::SystemUser );
+        $ticket->Load( $id );
+        ok( $ticket->id, 'loaded ticket' );
+        is( $ticket->FirstCustomFieldValue( 'Domain' ), $val, 'correct value' );
+    }
+}
+
+diag "create a ticket and edit Domain field using Edit page";
+{
+    my $i = 0;
+    my $incident_id;    # countermeasure couldn't be created without incident id
+    foreach my $queue ( 'Incidents', 'Incident Reports', 'Investigations', 'Countermeasures' ) {
+        diag "create a ticket in the '$queue' queue";
+
+        my $id = $agent->create_rtir_ticket_ok(
+            $queue,
+            {
+                Subject => "test domain in message",
+                ( $queue eq 'Countermeasures' ? ( Incident => $incident_id ) : () ),
+            },
+        );
+        $incident_id = $id if $queue eq 'Incidents';
+
+        my $field_name = "Object-RT::Ticket-$id-CustomField:Networking-" . $cf->id . "-Values";
+
+        diag "set Domain";
+        my $val = 'example.com';
+        $agent->follow_link_ok( { text => 'Edit', n => "1" }, "Followed 'Edit' link" );
+        $agent->form_number( 3 );
+        like( $agent->value( $field_name ), qr/^\s*$/, 'Domain is empty' );
+        $agent->field( $field_name => $val );
+        $agent->click( 'SaveChanges' );
+
+        $agent->content_like( qr/\Q$val/, "Domain on the page" );
+
+        my $ticket = RT::Ticket->new( $RT::SystemUser );
+        $ticket->Load( $id );
+        ok( $ticket->id, 'loaded ticket' );
+        my $values = $ticket->CustomFieldValues( 'Domain' );
+        my %has = map { $_->Content => 1 } @{ $values->ItemsArrayRef };
+        is( scalar values %has, 1, "one Domain were added" );
+        ok( $has{$val}, "has value" ) or diag "but has values " . join ", ", keys %has;
+
+        diag "set Domain with spaces around";
+        $val = "  example.net  \n  ";
+        $agent->follow_link_ok( { text => 'Edit', n => "1" }, "Followed 'Edit' link" );
+        $agent->form_number( 3 );
+        like( $agent->value( $field_name ), qr/^\s*\Qexample.com\E\s*$/, 'Domain is in input box' );
+        $agent->field( $field_name => $val );
+        $agent->click( 'SaveChanges' );
+
+        $agent->content_like( qr/\Qexample.com/, "Domain on the page" );
+
+        $ticket = RT::Ticket->new( $RT::SystemUser );
+        $ticket->Load( $id );
+        ok( $ticket->id, 'loaded ticket' );
+        $values = $ticket->CustomFieldValues( 'Domain' );
+        %has = map { $_->Content => 1 } @{ $values->ItemsArrayRef };
+        is( scalar values %has, 1, "one Domain were added" );
+        ok( $has{'example.net'}, "has value" ) or diag "but has values " . join ", ", keys %has;
+    }
+}
+
+diag "check that Domains in messages don't add duplicates";
+{
+    my $id = $agent->create_ir( { Subject => "test domain", Content => 'example.com example.com' } );
+    ok( $id, "created first ticket" );
+
+    my $ticket = RT::Ticket->new( $RT::SystemUser );
+    $ticket->Load( $id );
+    ok( $ticket->id, 'loaded ticket' );
+
+    my $values = $ticket->CustomFieldValues( 'Domain' );
+    my %has;
+    $has{ $_->Content }++ foreach @{ $values->ItemsArrayRef };
+    is( scalar values %has, 1, "one Domain were added" );
+    ok( !grep( $_ != 1, values %has ), "no duplicated values" );
+    ok( $has{'example.com'}, "Domain is there" );
+}
+
+diag "search tickets by Domain";
+{
+    my $id = $agent->create_ir( { Subject => "test domain", Content => 'search.example.com' } );
+    ok( $id, "created first ticket" );
+
+    my $tickets = RT::Tickets->new( $rtir_user );
+    $tickets->FromSQL( "id = $id AND CF.{Domain} = 'search.example.com'" );
+    ok( $tickets->Count, "found tickets" );
+
+    my $flag = 1;
+    while ( my $ticket = $tickets->Next ) {
+        my %has = map { $_->Content => 1 } @{ $ticket->CustomFieldValues( 'Domain' )->ItemsArrayRef };
+        next if $has{'search.example.com'};
+        $flag = 0;
+        ok( 0, "ticket #" . $ticket->id . " has no Domain search.example.com, but should" )
+          or diag "but has values " . join ", ", keys %has;
+        last;
+    }
+    ok( 1, "all tickets has Domain search.example.com" ) if $flag;
+}
+
+diag "merge ticket, Domains should be merged";
+{
+    my $incident_id = $agent->create_rtir_ticket_ok( 'Incidents', { Subject => "test" }, );
+    my $b1_id = $agent->create_countermeasure(
+        { Subject => "test domain", Incident => $incident_id, },
+        { Domain  => 'example.com' },
+    );
+    my $b2_id = $agent->create_countermeasure(
+        { Subject => "test domain", Incident => $incident_id, },
+        { Domain  => 'foobar.net' },
+    );
+
+    $agent->display_ticket( $b1_id );
+    $agent->follow_link_ok( { text => 'Merge' }, "Followed merge link" );
+    $agent->form_number( 3 );
+    $agent->field( 'SelectedTicket', $b2_id );
+    $agent->submit;
+    $agent->ok_and_content_like( qr{Merge Successful}, 'Merge Successful' );
+
+    my $ticket = RT::Ticket->new( $RT::SystemUser );
+    $ticket->Load( $b1_id );
+    ok $ticket->id, 'loaded ticket';
+    my $values = $ticket->CustomFieldValues( 'Domain' );
+    my %has = map { $_->Content => 1 } @{ $values->ItemsArrayRef };
+    is( scalar values %has, 2, "both Domains are there" );
+    ok( $has{'example.com'}, "has value" ) or diag "but has values " . join ", ", keys %has;
+    ok( $has{'foobar.net'},  "has value" ) or diag "but has values " . join ", ", keys %has;
+}
+
+diag "merge ticket with the same Domain";
+{
+    my $incident_id = $agent->create_rtir_ticket_ok( 'Incidents', { Subject => "test" }, );
+    my $b1_id = $agent->create_countermeasure(
+        { Subject => "test domain", Incident => $incident_id, },
+        { Domain  => 'example.com' },
+    );
+    my $b2_id = $agent->create_countermeasure(
+        { Subject => "test domain", Incident => $incident_id, },
+        { Domain  => 'example.com' },
+    );
+
+    $agent->display_ticket( $b1_id );
+    $agent->follow_link_ok( { text => 'Merge' }, "Followed merge link" );
+    $agent->form_number( 3 );
+    $agent->field( 'SelectedTicket', $b2_id );
+    $agent->submit;
+    $agent->ok_and_content_like( qr{Merge Successful}, 'Merge Successful' );
+
+    my $ticket = RT::Ticket->new( $RT::SystemUser );
+    $ticket->Load( $b1_id );
+    ok $ticket->id, 'loaded ticket';
+    my $values = $ticket->CustomFieldValues( 'Domain' );
+    my @has = map $_->Content, @{ $values->ItemsArrayRef };
+    is( scalar @has, 1, "only one Domain" ) or diag "values: @has";
+    is( $has[ 0 ], 'example.com', "has value" );
+}
+
+diag "test various valid domains";
+{
+    my @valid_domains = (
+        'example.com', 'foo.example.net', 'bar.example.org',    # classical tld
+        'test.example', 'test.us', 'test.cc', 'test.edu',       # newer tld
+        'foo-bar.com',                                          # dash
+        'foo-bar-baz.com',                                      # multiple dashes
+        'xn--0zwm56d.com',                                      # international domain with punycode
+        't' x 63 . '.com',                                      # part with 63 chars
+        't.' x 125 . 'com',                                     # 253 chars
+    );
+
+    for my $domain ( @valid_domains ) {
+        my $id = $agent->create_rtir_ticket_ok( 'Incident Reports', { Subject => "test", Content => $domain }, );
+        my $ticket = RT::Ticket->new( $RT::SystemUser );
+        $ticket->Load( $id );
+        ok( $ticket->id, 'loaded ticket' );
+        is( $ticket->FirstCustomFieldValue( 'Domain' ), $domain, "Domain $domain is extracted" );
+    }
+}
+
+diag "test various invalid domains";
+{
+    my @invalid_domains = (
+        'test.bla',            # invalid tld
+        '.com',                # top domain only
+        '-.com',               # part starts with a dash
+        't' x 64 . '.com',     # part exceeds 63 chars
+        't.' x 126 . 'com',    # exceeds 253 chars
+    );
+
+    for my $domain ( @invalid_domains ) {
+        my $id = $agent->create_rtir_ticket_ok( 'Incident Reports', { Subject => "test", Content => $domain }, );
+        my $ticket = RT::Ticket->new( $RT::SystemUser );
+        $ticket->Load( $id );
+        ok( $ticket->id,                                 'loaded ticket' );
+        ok( !$ticket->FirstCustomFieldValue( 'Domain' ), "Inalid domain $domain is not defined" );
+    }
+}
+
+RT::Test->stop_server;
+RT->Config->Set( 'RTIR_StrictDomainTLD', 0 );
+RT::Test->started_ok;
+
+$agent = default_agent();
+
+diag "test invalid tld domains without strict domain tld";
+{
+    my @invalid_domains = (
+        'test.bla',
+    );
+
+    for my $domain ( @invalid_domains ) {
+        my $id = $agent->create_rtir_ticket_ok( 'Incident Reports', { Subject => "test", Content => $domain }, );
+        my $ticket = RT::Ticket->new( $RT::SystemUser );
+        $ticket->Load( $id );
+        ok( $ticket->id,                                 'loaded ticket' );
+        is( $ticket->FirstCustomFieldValue( 'Domain' ), $domain, "Domain $domain is extracted" );
+    }
+}
+
+done_testing;

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


More information about the rt-commit mailing list