Mercurial > hg > nginx-tests
comparison lib/Test/Nginx/POP3.pm @ 59:bc3351f157ef
Tests: add basic pop3 and imap tests.
author | Maxim Dounin <mdounin@mdounin.ru> |
---|---|
date | Mon, 12 Jan 2009 06:08:05 +0300 |
parents | |
children | 465a711ffa19 |
comparison
equal
deleted
inserted
replaced
58:d053b4bf6ec6 | 59:bc3351f157ef |
---|---|
1 package Test::Nginx::POP3; | |
2 | |
3 # (C) Maxim Dounin | |
4 | |
5 # Module for nginx pop3 tests. | |
6 | |
7 ############################################################################### | |
8 | |
9 use warnings; | |
10 use strict; | |
11 | |
12 use Test::More qw//; | |
13 use IO::Socket; | |
14 use Socket qw/ CRLF /; | |
15 | |
16 use Test::Nginx; | |
17 | |
18 use base qw/ IO::Socket::INET /; | |
19 | |
20 sub new { | |
21 my $class = shift; | |
22 | |
23 my $self = return $class->SUPER::new( | |
24 Proto => "tcp", | |
25 PeerAddr => "127.0.0.1:8110", | |
26 @_ | |
27 ) | |
28 or die "Can't connect to nginx: $!\n"; | |
29 | |
30 $self->autoflush(1); | |
31 | |
32 return $self; | |
33 } | |
34 | |
35 sub send { | |
36 my ($self, $cmd) = @_; | |
37 log_out($cmd); | |
38 $self->print($cmd . CRLF); | |
39 } | |
40 | |
41 sub read { | |
42 my ($self) = @_; | |
43 eval { | |
44 alarm(2); | |
45 local $SIG{ALRM} = sub { die "alarm\n" }; | |
46 while (<$self>) { | |
47 log_in($_); | |
48 # XXX | |
49 next if m/^\d\d\d-/; | |
50 last; | |
51 } | |
52 alarm(0); | |
53 }; | |
54 alarm(0); | |
55 if ($@) { | |
56 return undef; | |
57 } | |
58 return $_; | |
59 } | |
60 | |
61 sub check { | |
62 my ($self, $regex, $name) = @_; | |
63 Test::More->builder->like($self->read(), $regex, $name); | |
64 } | |
65 | |
66 sub ok { | |
67 my $self = shift; | |
68 Test::More->builder->like($self->read(), qr/^\+OK/, @_); | |
69 } | |
70 | |
71 ############################################################################### | |
72 | |
73 sub pop3_test_daemon { | |
74 my $server = IO::Socket::INET->new( | |
75 Proto => 'tcp', | |
76 LocalAddr => '127.0.0.1:8111', | |
77 Listen => 5, | |
78 Reuse => 1 | |
79 ) | |
80 or die "Can't create listening socket: $!\n"; | |
81 | |
82 while (my $client = $server->accept()) { | |
83 $client->autoflush(1); | |
84 print $client "+OK fake pop3 server ready" . CRLF; | |
85 | |
86 while (<$client>) { | |
87 if (/^quit/i) { | |
88 print $client '+OK quit ok' . CRLF; | |
89 } elsif (/^user test\@example.com/i) { | |
90 print $client '+OK user ok' . CRLF; | |
91 } elsif (/^pass secret/i) { | |
92 print $client '+OK pass ok' . CRLF; | |
93 } else { | |
94 print $client "-ERR unknown command" . CRLF; | |
95 } | |
96 } | |
97 | |
98 close $client; | |
99 } | |
100 } | |
101 | |
102 ############################################################################### | |
103 | |
104 1; | |
105 | |
106 ############################################################################### |