summaryrefslogtreecommitdiffstats
path: root/t
diff options
context:
space:
mode:
Diffstat (limited to 't')
-rw-r--r--t/01_basic.t2
-rw-r--r--t/02_noop.t2
-rw-r--r--t/03_other_mailbox.t2
-rw-r--r--t/04_reconnect.t66
-rw-r--r--t/05_reconnect_noop.t70
-rw-r--r--t/06_early_connection_loss.t73
6 files changed, 212 insertions, 3 deletions
diff --git a/t/01_basic.t b/t/01_basic.t
index 6f9d076..7afc839 100644
--- a/t/01_basic.t
+++ b/t/01_basic.t
@@ -31,7 +31,7 @@ $socket->set_series('readline',
")\r\n",
);
-$socket->set_true(qw(writeline));
+$socket->set_true(qw(writeline reconnect));
my $config = {
log_id => 'test-id1',
diff --git a/t/02_noop.t b/t/02_noop.t
index f1d4ab5..d479efc 100644
--- a/t/02_noop.t
+++ b/t/02_noop.t
@@ -39,7 +39,7 @@ my @input_lines = (
my $socket = Test::MockObject->new();
$socket->mock('readline', sub {my $x = shift @input_lines; ref($x) eq "CODE" ? $x->() : $x;});
-$socket->set_true(qw(writeline));
+$socket->set_true(qw(writeline reconnect));
my $config = {
log_id => 'test-id1',
diff --git a/t/03_other_mailbox.t b/t/03_other_mailbox.t
index a1ef59a..443fc68 100644
--- a/t/03_other_mailbox.t
+++ b/t/03_other_mailbox.t
@@ -47,7 +47,7 @@ my @input_lines = (
my $socket = Test::MockObject->new();
$socket->mock('readline', sub {my $x = shift @input_lines; ref($x) eq "CODE" ? $x->() : $x;});
-$socket->set_true(qw(writeline));
+$socket->set_true(qw(writeline reconnect));
my $config = {
log_id => 'test-id1',
diff --git a/t/04_reconnect.t b/t/04_reconnect.t
new file mode 100644
index 0000000..987db8e
--- /dev/null
+++ b/t/04_reconnect.t
@@ -0,0 +1,66 @@
+use strict;
+use warnings;
+use Test::Differences;
+use Test::More;
+use Test::MockObject;
+
+use Log::Any::Adapter ('Stderr', log_level => "warn");
+
+use App::ImapNotify;
+use App::ImapNotify::ImapClient;
+
+=head1 DESCRIPTION
+
+Simulate a connection loss (readline on socket returns undef).
+
+=cut
+
+my @input_lines = (
+ "* OK [CAPABILITY IMAP4rev1 SASL-IR LOGIN-REFERRALS ID ENABLE IDLE LITERAL+ AUTH=PLAIN AUTH=LOGIN] Fake server ready.\r\n",
+ "CMD-0 OK [CAPABILITY IMAP4rev1 SASL-IR LOGIN-REFERRALS ID ENABLE IDLE SORT SORT=DISPLAY THREAD=REFERENCES THREAD=REFS THREAD=ORDEREDSUBJECT MULTIAPPEND URL-PARTIAL CATENATE UNSELECT CHILDREN NAMESPACE UIDPLUS LIST-EXTENDED I18NLEVEL=1 CONDSTORE QRESYNC ESEARCH ESORT SEARCHRES WITHIN CONTEXT=SEARCH LIST-STATUS BINARY MOVE SNIPPET=FUZZY LITERAL+ NOTIFY SPECIAL-USE COMPRESS=DEFLATE] Logged in\r\n",
+ "CMD-1 OK [READ-WRITE] Select completed (0.001 + 0.000 secs).\r\n",
+ "CMD-2 OK NOTIFY completed (0.001 + 0.000 secs).\r\n",
+ # "connection loss"
+ undef,
+ # client should reconnect
+ "* OK [CAPABILITY IMAP4rev1 SASL-IR LOGIN-REFERRALS ID ENABLE IDLE LITERAL+ AUTH=PLAIN AUTH=LOGIN] Fake server ready.\r\n",
+ "CMD-0 OK [CAPABILITY IMAP4rev1 SASL-IR LOGIN-REFERRALS ID ENABLE IDLE SORT SORT=DISPLAY THREAD=REFERENCES THREAD=REFS THREAD=ORDEREDSUBJECT MULTIAPPEND URL-PARTIAL CATENATE UNSELECT CHILDREN NAMESPACE UIDPLUS LIST-EXTENDED I18NLEVEL=1 CONDSTORE QRESYNC ESEARCH ESORT SEARCHRES WITHIN CONTEXT=SEARCH LIST-STATUS BINARY MOVE SNIPPET=FUZZY LITERAL+ NOTIFY SPECIAL-USE COMPRESS=DEFLATE] Logged in\r\n",
+ "CMD-1 OK [READ-WRITE] Select completed (0.001 + 0.000 secs).\r\n",
+ "CMD-2 OK NOTIFY completed (0.001 + 0.000 secs).\r\n",
+);
+
+my $socket = Test::MockObject->new();
+$socket->mock('readline', sub {my $x = shift @input_lines; ref($x) eq "CODE" ? $x->() : $x;});
+$socket->set_true(qw(writeline reconnect));
+
+my $config = {
+ log_id => 'test-id1',
+ host => 'localhost.localdomain',
+ port => 993,
+ username => 'tester1',
+ password => 'secretPW42',
+ mailboxes => [qw(INBOX INBOX.test)],
+ keepalive_timeout => 300,
+};
+
+my $imap_client = App::ImapNotify::ImapClient->new_no_defaults($config, {sock => $socket});
+
+my $app = App::ImapNotify->new_no_defaults($config, {imap_client => $imap_client});
+
+$app->loop();
+$app->loop();
+
+is(scalar(@input_lines), 0, "all input lines are read");
+
+eq_or_diff([grep { $_->[0] eq "writeline" } $socket->_calls()->@*], [
+ ['writeline', [$socket, "CMD-0 login tester1 secretPW42\r\n"]],
+ ['writeline', [$socket, "CMD-1 select INBOX\r\n"]],
+ ['writeline', [$socket, "CMD-2 notify set (selected (MessageExpunge MessageNew (uid body.peek[header.fields (from to subject)]))) (mailboxes (INBOX INBOX.test) (MessageNew MessageExpunge MailboxName))\r\n"]],
+ ['writeline', [$socket, "CMD-0 login tester1 secretPW42\r\n"]],
+ ['writeline', [$socket, "CMD-1 select INBOX\r\n"]],
+ ['writeline', [$socket, "CMD-2 notify set (selected (MessageExpunge MessageNew (uid body.peek[header.fields (from to subject)]))) (mailboxes (INBOX INBOX.test) (MessageNew MessageExpunge MailboxName))\r\n"]],
+ ], "socket writeline is called correctly");
+
+is(scalar(grep { $_->[0] eq "reconnect" } $socket->_calls()->@*), 2, "socket reconnect is called twice");
+
+done_testing;
diff --git a/t/05_reconnect_noop.t b/t/05_reconnect_noop.t
new file mode 100644
index 0000000..008b461
--- /dev/null
+++ b/t/05_reconnect_noop.t
@@ -0,0 +1,70 @@
+use strict;
+use warnings;
+use Test::Differences;
+use Test::More;
+use Test::MockObject;
+use Test::Exception;
+
+use Log::Any::Adapter ('Stderr', log_level => "warn");
+
+use App::ImapNotify;
+use App::ImapNotify::ImapClient;
+
+=head1 DESCRIPTION
+
+Simulate a connection loss when sending noop (readline on socket returns undef).
+
+=cut
+
+my @input_lines = (
+ "* OK [CAPABILITY IMAP4rev1 SASL-IR LOGIN-REFERRALS ID ENABLE IDLE LITERAL+ AUTH=PLAIN AUTH=LOGIN] Fake server ready.\r\n",
+ "CMD-0 OK [CAPABILITY IMAP4rev1 SASL-IR LOGIN-REFERRALS ID ENABLE IDLE SORT SORT=DISPLAY THREAD=REFERENCES THREAD=REFS THREAD=ORDEREDSUBJECT MULTIAPPEND URL-PARTIAL CATENATE UNSELECT CHILDREN NAMESPACE UIDPLUS LIST-EXTENDED I18NLEVEL=1 CONDSTORE QRESYNC ESEARCH ESORT SEARCHRES WITHIN CONTEXT=SEARCH LIST-STATUS BINARY MOVE SNIPPET=FUZZY LITERAL+ NOTIFY SPECIAL-USE COMPRESS=DEFLATE] Logged in\r\n",
+ "CMD-1 OK [READ-WRITE] Select completed (0.001 + 0.000 secs).\r\n",
+ "CMD-2 OK NOTIFY completed (0.001 + 0.000 secs).\r\n",
+ # wait for client to send noop
+ sub {sleep 10; fail("Keepalive failed to kill readline() operation");},
+ # "connection loss"
+ undef,
+ # client should reconnect
+ "* OK [CAPABILITY IMAP4rev1 SASL-IR LOGIN-REFERRALS ID ENABLE IDLE LITERAL+ AUTH=PLAIN AUTH=LOGIN] Fake server ready.\r\n",
+ "CMD-0 OK [CAPABILITY IMAP4rev1 SASL-IR LOGIN-REFERRALS ID ENABLE IDLE SORT SORT=DISPLAY THREAD=REFERENCES THREAD=REFS THREAD=ORDEREDSUBJECT MULTIAPPEND URL-PARTIAL CATENATE UNSELECT CHILDREN NAMESPACE UIDPLUS LIST-EXTENDED I18NLEVEL=1 CONDSTORE QRESYNC ESEARCH ESORT SEARCHRES WITHIN CONTEXT=SEARCH LIST-STATUS BINARY MOVE SNIPPET=FUZZY LITERAL+ NOTIFY SPECIAL-USE COMPRESS=DEFLATE] Logged in\r\n",
+ "CMD-1 OK [READ-WRITE] Select completed (0.001 + 0.000 secs).\r\n",
+ "CMD-2 OK NOTIFY completed (0.001 + 0.000 secs).\r\n",
+);
+
+my $socket = Test::MockObject->new();
+$socket->mock('readline', sub {my $x = shift @input_lines; ref($x) eq "CODE" ? $x->() : $x;});
+$socket->set_true(qw(writeline reconnect));
+
+my $config = {
+ log_id => 'test-id1',
+ host => 'localhost.localdomain',
+ port => 993,
+ username => 'tester1',
+ password => 'secretPW42',
+ mailboxes => [qw(INBOX INBOX.test)],
+ keepalive_timeout => 0.01,
+};
+
+my $imap_client = App::ImapNotify::ImapClient->new_no_defaults($config, {sock => $socket});
+
+my $app = App::ImapNotify->new_no_defaults($config, {imap_client => $imap_client});
+
+throws_ok {$app->loop();} qr/^Lost connection while waiting for reply to command 'noop'/, "Expect connection loss";
+$app->loop();
+
+is(scalar(@input_lines), 0, "all input lines are read");
+
+eq_or_diff([grep { $_->[0] eq "writeline" } $socket->_calls()->@*], [
+ ['writeline', [$socket, "CMD-0 login tester1 secretPW42\r\n"]],
+ ['writeline', [$socket, "CMD-1 select INBOX\r\n"]],
+ ['writeline', [$socket, "CMD-2 notify set (selected (MessageExpunge MessageNew (uid body.peek[header.fields (from to subject)]))) (mailboxes (INBOX INBOX.test) (MessageNew MessageExpunge MailboxName))\r\n"]],
+ ['writeline', [$socket, "CMD-3 noop\r\n"]],
+ ['writeline', [$socket, "CMD-0 login tester1 secretPW42\r\n"]],
+ ['writeline', [$socket, "CMD-1 select INBOX\r\n"]],
+ ['writeline', [$socket, "CMD-2 notify set (selected (MessageExpunge MessageNew (uid body.peek[header.fields (from to subject)]))) (mailboxes (INBOX INBOX.test) (MessageNew MessageExpunge MailboxName))\r\n"]],
+ ], "socket writeline is called correctly");
+
+is(scalar(grep { $_->[0] eq "reconnect" } $socket->_calls()->@*), 2, "socket reconnect is called twice");
+
+done_testing;
diff --git a/t/06_early_connection_loss.t b/t/06_early_connection_loss.t
new file mode 100644
index 0000000..105ea29
--- /dev/null
+++ b/t/06_early_connection_loss.t
@@ -0,0 +1,73 @@
+use strict;
+use warnings;
+use Test::Differences;
+use Test::More;
+use Test::MockObject;
+use Test::Exception;
+
+use Log::Any::Adapter ('Stderr', log_level => "trace");
+
+use App::ImapNotify;
+use App::ImapNotify::ImapClient;
+
+=head1 DESCRIPTION
+
+Simulate a connection loss during early stages of the connection.
+
+=cut
+
+my @input_lines = (
+ "* OK [CAPABILITY IMAP4rev1 SASL-IR LOGIN-REFERRALS ID ENABLE IDLE LITERAL+ AUTH=PLAIN AUTH=LOGIN] Fake server ready.\r\n",
+ "CMD-0 OK [CAPABILITY IMAP4rev1 SASL-IR LOGIN-REFERRALS ID ENABLE IDLE SORT SORT=DISPLAY THREAD=REFERENCES THREAD=REFS THREAD=ORDEREDSUBJECT MULTIAPPEND URL-PARTIAL CATENATE UNSELECT CHILDREN NAMESPACE UIDPLUS LIST-EXTENDED I18NLEVEL=1 CONDSTORE QRESYNC ESEARCH ESORT SEARCHRES WITHIN CONTEXT=SEARCH LIST-STATUS BINARY MOVE SNIPPET=FUZZY LITERAL+ NOTIFY SPECIAL-USE COMPRESS=DEFLATE] Logged in\r\n",
+ "CMD-1 OK [READ-WRITE] Select completed (0.001 + 0.000 secs).\r\n",
+ "CMD-2 OK NOTIFY completed (0.001 + 0.000 secs).\r\n",
+);
+
+my $socket = Test::MockObject->new();
+$socket->set_true(qw(writeline reconnect));
+
+my $config = {
+ log_id => 'test-id1',
+ host => 'localhost.localdomain',
+ port => 993,
+ username => 'tester1',
+ password => 'secretPW42',
+ mailboxes => [qw(INBOX INBOX.test)],
+ keepalive_timeout => 300,
+};
+
+my $imap_client = App::ImapNotify::ImapClient->new_no_defaults($config, {sock => $socket});
+
+my $app = App::ImapNotify->new_no_defaults($config, {imap_client => $imap_client});
+
+$socket->set_series('readline', undef);
+throws_ok {$app->loop();} qr/^Lost connection while waiting for server greeting/, "Expect connection loss";
+eq_or_diff([grep { $_->[0] eq "writeline" } $socket->_calls()->@*], [
+ ], "Connection loss before receiving greeting");
+$socket->clear();
+
+$socket->set_series('readline', @input_lines[0..0], undef);
+throws_ok {$app->loop();} qr/^Lost connection while waiting for reply to command 'login tester1 secretPW42'/, "Expect connection loss";
+eq_or_diff([grep { $_->[0] eq "writeline" } $socket->_calls()->@*], [
+ ['writeline', [$socket, "CMD-0 login tester1 secretPW42\r\n"]],
+ ], "Connection loss after sending login");
+$socket->clear();
+
+$socket->set_series('readline', @input_lines[0..1], undef);
+throws_ok {$app->loop();} qr/^Lost connection while waiting for reply to command 'select INBOX'/, "Expect connection loss";
+eq_or_diff([grep { $_->[0] eq "writeline" } $socket->_calls()->@*], [
+ ['writeline', [$socket, "CMD-0 login tester1 secretPW42\r\n"]],
+ ['writeline', [$socket, "CMD-1 select INBOX\r\n"]],
+ ], "Connection loss after sending select");
+$socket->clear();
+
+$socket->set_series('readline', @input_lines[0..2], undef);
+throws_ok {$app->loop();} qr/^Lost connection while waiting for reply to command 'notify set \(.*\)'/, "Expect connection loss";
+eq_or_diff([grep { $_->[0] eq "writeline" } $socket->_calls()->@*], [
+ ['writeline', [$socket, "CMD-0 login tester1 secretPW42\r\n"]],
+ ['writeline', [$socket, "CMD-1 select INBOX\r\n"]],
+ ['writeline', [$socket, "CMD-2 notify set (selected (MessageExpunge MessageNew (uid body.peek[header.fields (from to subject)]))) (mailboxes (INBOX INBOX.test) (MessageNew MessageExpunge MailboxName))\r\n"]],
+ ], "Connection loss after sending notify");
+$socket->clear();
+
+done_testing;
generated by cgit v1.2.3-24-g4f1b (git 2.32.0) at 2024-11-21 16:05:19 +0100