Mercurial > hg > nginx-tests
comparison lib/Test/Nginx/IMAP.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::IMAP; | |
2 | |
3 # (C) Maxim Dounin | |
4 | |
5 # Module for nginx imap 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:8143", | |
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/^\S+ OK/, @_); | |
69 } | |
70 | |
71 ############################################################################### | |
72 | |
73 sub imap_test_daemon { | |
74 my $server = IO::Socket::INET->new( | |
75 Proto => 'tcp', | |
76 LocalAddr => '127.0.0.1:8144', | |
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 imap server ready" . CRLF; | |
85 | |
86 while (<$client>) { | |
87 my $tag = ''; | |
88 | |
89 $tag = $1 if m/^(\S+)/; | |
90 s/^(\S+)\s+//; | |
91 | |
92 if (/^logout/i) { | |
93 print $client $tag . ' OK logout ok' . CRLF; | |
94 } elsif (/^login /i) { | |
95 print $client $tag . ' OK login ok' . CRLF; | |
96 } else { | |
97 print $client $tag . ' ERR unknown command' . CRLF; | |
98 } | |
99 } | |
100 | |
101 close $client; | |
102 } | |
103 } | |
104 | |
105 ############################################################################### | |
106 | |
107 1; | |
108 | |
109 ############################################################################### |