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;