1package ProFTPD::Tests::Modules::mod_ban::memcache;
2
3use lib qw(t/lib);
4use base qw(ProFTPD::TestSuite::Child);
5use strict;
6
7use Cache::Memcached;
8use File::Spec;
9use IO::Handle;
10
11use ProFTPD::TestSuite::FTP;
12use ProFTPD::TestSuite::Utils qw(:auth :config :running :test :testsuite);
13
14$| = 1;
15
16my $order = 0;
17
18my $TESTS = {
19  ban_memcache_max_login_attempts => {
20    order => ++$order,
21    test_class => [qw(forking)],
22  },
23
24  ban_memcache_json_max_login_attempts_bug4056 => {
25    order => ++$order,
26    test_class => [qw(bug forking)],
27  },
28
29};
30
31sub new {
32  return shift()->SUPER::new(@_);
33}
34
35sub set_up {
36  my $self = shift;
37  $self->SUPER::set_up(@_);
38
39  # Clear the memcached servers before each unit test
40  my $memcached_servers = $ENV{MEMCACHED_SERVERS} ? $ENV{MEMCACHED_SERVERS} : "127.0.0.1:11211";
41
42  my $mc = Cache::Memcached->new({
43    servers => [ $memcached_servers ],
44    debug => 0,
45  });
46
47  # First, make sure that a memcached is running
48  my $stats = $mc->stats('misc');
49  unless ($stats) {
50    die("Can't obtain stats from memached servers '$memcached_servers'");
51  }
52
53  $mc->flush_all();
54  $mc->disconnect_all();
55}
56
57sub list_tests {
58  return testsuite_get_runnable_tests($TESTS);
59}
60
61sub ban_memcache_max_login_attempts {
62  my $self = shift;
63  my $tmpdir = $self->{tmpdir};
64  my $setup = test_setup($tmpdir, 'ban');
65
66  my $ban_tab = File::Spec->rel2abs("$tmpdir/ban.tab");
67  my $memcached_servers = $ENV{MEMCACHED_SERVERS} ? $ENV{MEMCACHED_SERVERS} : '127.0.0.1:11211';
68
69  my $config = {
70    PidFile => $setup->{pid_file},
71    ScoreboardFile => $setup->{scoreboard_file},
72    SystemLog => $setup->{log_file},
73    TraceLog => $setup->{log_file},
74    Trace => 'ban:20 memcache:20',
75
76    AuthUserFile => $setup->{auth_user_file},
77    AuthGroupFile => $setup->{auth_group_file},
78
79    MaxLoginAttempts => 1,
80
81    IfModules => {
82      'mod_ban.c' => {
83        BanEngine => 'on',
84        BanLog => $setup->{log_file},
85
86        # This says to ban a client which exceeds the MaxLoginAttempts
87        # limit once within the last 1 minute will be banned for 3 min
88        BanOnEvent => 'MaxLoginAttempts 1/00:01:00 00:03:00',
89
90        BanTable => $ban_tab,
91
92        BanCache => 'memcache',
93      },
94
95      'mod_delay.c' => {
96        DelayEngine => 'off',
97      },
98
99      'mod_memcache.c' => {
100        MemcacheEngine => 'on',
101        MemcacheLog => $setup->{log_file},
102        MemcacheServers => $memcached_servers,
103      },
104    },
105  };
106
107  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
108    $config);
109
110  # Open pipes, for use between the parent and child processes.  Specifically,
111  # the child will indicate when it's done with its test by writing a message
112  # to the parent.
113  my ($rfh, $wfh);
114  unless (pipe($rfh, $wfh)) {
115    die("Can't open pipe: $!");
116  }
117
118  my $ex;
119
120  # Fork child
121  $self->handle_sigchld();
122  defined(my $pid = fork()) or die("Can't fork: $!");
123  if ($pid) {
124    eval {
125      my $client = ProFTPD::TestSuite::FTP->new('127.0.0.1', $port, 0, 1);
126      eval { $client->login($setup->{user}, 'foo') };
127      unless ($@) {
128        die("Login succeeded unexpectedly");
129      }
130
131      my $resp_code = $client->response_code();
132      my $resp_msg = $client->response_msg();
133
134      my $expected;
135
136      $expected = 530;
137      $self->assert($expected == $resp_code,
138        test_msg("Expected response code $expected, got $resp_code"));
139
140      $expected = "Login incorrect.";
141      $self->assert($expected eq $resp_msg,
142        test_msg("Expected response message '$expected', got '$resp_msg'"));
143
144      eval { ProFTPD::TestSuite::FTP->new('127.0.0.1', $port, undef, 0); };
145      unless ($@) {
146        die("Connect succeeded unexpectedly");
147      }
148
149      my $conn_ex = ProFTPD::TestSuite::FTP::get_connect_exception();
150
151      my $expected = "";
152      $self->assert($expected eq $conn_ex,
153        test_msg("Expected '$expected', got '$conn_ex'"));
154    };
155
156    if ($@) {
157      $ex = $@;
158    }
159
160    $wfh->print("done\n");
161    $wfh->flush();
162
163  } else {
164    eval { server_wait($setup->{config_file}, $rfh) };
165    if ($@) {
166      warn($@);
167      exit 1;
168    }
169
170    exit 0;
171  }
172
173  # Stop server
174  server_stop($setup->{pid_file});
175
176  $self->assert_child_ok($pid);
177
178  if ($ex) {
179    die($ex);
180  }
181
182  # Close the pipe, then re-open it for the second daemon
183  close($rfh);
184  close($wfh);
185
186  unless (pipe($rfh, $wfh)) {
187    die("Can't open pipe: $!");
188  }
189
190  # Fork child
191  defined($pid = fork()) or die("Can't fork: $!");
192  if ($pid) {
193    eval {
194      # Now try again with the correct info; we should be banned.  Note
195      # that we have to create a separate connection for this.
196
197      # Give the server some time to start up.
198      sleep(2);
199
200      eval { ProFTPD::TestSuite::FTP->new('127.0.0.1', $port, undef, 0); };
201      unless ($@) {
202        die("Connect succeeded unexpectedly");
203      }
204
205      my $conn_ex = ProFTPD::TestSuite::FTP::get_connect_exception();
206
207      # If we see an exception of "Net::FTP: connect: Connection refused",
208      # it means that the daemon hadn't even started up yet, which is not
209      # the same as listening but rejecting our connection.
210
211      my $expected = '';
212      $self->assert($expected eq $conn_ex,
213        test_msg("Expected '$expected', got '$conn_ex'"));
214    };
215
216    if ($@) {
217      $ex = $@;
218    }
219
220    $wfh->print("done\n");
221    $wfh->flush();
222
223  } else {
224    eval { server_wait($setup->{config_file}, $rfh) };
225    if ($@) {
226      warn($@);
227      exit 1;
228    }
229
230    exit 0;
231  }
232
233  # Stop server
234  server_stop($setup->{pid_file});
235
236  $self->assert_child_ok($pid);
237
238  test_cleanup($setup->{log_file}, $ex);
239}
240
241sub ban_memcache_json_max_login_attempts_bug4056 {
242  my $self = shift;
243  my $tmpdir = $self->{tmpdir};
244  my $setup = test_setup($tmpdir, 'ban');
245
246  my $ban_tab = File::Spec->rel2abs("$tmpdir/ban.tab");
247  my $memcached_servers = $ENV{MEMCACHED_SERVERS} ? $ENV{MEMCACHED_SERVERS} : '127.0.0.1:11211';
248
249  my $config = {
250    PidFile => $setup->{pid_file},
251    ScoreboardFile => $setup->{scoreboard_file},
252    SystemLog => $setup->{log_file},
253    TraceLog => $setup->{log_file},
254    Trace => 'ban:20 memcache:20',
255
256    AuthUserFile => $setup->{auth_user_file},
257    AuthGroupFile => $setup->{auth_group_file},
258
259    MaxLoginAttempts => 1,
260
261    IfModules => {
262      'mod_ban.c' => {
263        BanEngine => 'on',
264        BanLog => $setup->{log_file},
265
266        # This says to ban a client which exceeds the MaxLoginAttempts
267        # limit once within the last 1 minute will be banned for 3 min
268        BanOnEvent => 'MaxLoginAttempts 1/00:01:00 00:03:00',
269
270        BanTable => $ban_tab,
271
272        BanCache => 'memcache',
273        BanCacheOptions => 'UseJSON',
274      },
275
276      'mod_delay.c' => {
277        DelayEngine => 'off',
278      },
279
280      'mod_memcache.c' => {
281        MemcacheEngine => 'on',
282        MemcacheLog => $setup->{log_file},
283        MemcacheServers => $memcached_servers,
284      },
285    },
286  };
287
288  my ($port, $config_user, $config_group) = config_write($setup->{config_file},
289    $config);
290
291  # Open pipes, for use between the parent and child processes.  Specifically,
292  # the child will indicate when it's done with its test by writing a message
293  # to the parent.
294  my ($rfh, $wfh);
295  unless (pipe($rfh, $wfh)) {
296    die("Can't open pipe: $!");
297  }
298
299  my $ex;
300
301  # Fork child
302  $self->handle_sigchld();
303  defined(my $pid = fork()) or die("Can't fork: $!");
304  if ($pid) {
305    eval {
306      my $client = ProFTPD::TestSuite::FTP->new('127.0.0.1', $port, 0, 1);
307      eval { $client->login($setup->{user}, 'foo') };
308      unless ($@) {
309        die("Login succeeded unexpectedly");
310      }
311
312      my $resp_code = $client->response_code();
313      my $resp_msg = $client->response_msg();
314
315      my $expected;
316
317      $expected = 530;
318      $self->assert($expected == $resp_code,
319        test_msg("Expected response code $expected, got $resp_code"));
320
321      $expected = "Login incorrect.";
322      $self->assert($expected eq $resp_msg,
323        test_msg("Expected response message '$expected', got '$resp_msg'"));
324
325      eval { ProFTPD::TestSuite::FTP->new('127.0.0.1', $port, undef, 0); };
326      unless ($@) {
327        die("Connect succeeded unexpectedly");
328      }
329
330      my $conn_ex = ProFTPD::TestSuite::FTP::get_connect_exception();
331
332      my $expected = "";
333      $self->assert($expected eq $conn_ex,
334        test_msg("Expected '$expected', got '$conn_ex'"));
335    };
336
337    if ($@) {
338      $ex = $@;
339    }
340
341    $wfh->print("done\n");
342    $wfh->flush();
343
344  } else {
345    eval { server_wait($setup->{config_file}, $rfh) };
346    if ($@) {
347      warn($@);
348      exit 1;
349    }
350
351    exit 0;
352  }
353
354  # Stop server
355  server_stop($setup->{pid_file});
356
357  $self->assert_child_ok($pid);
358
359  if ($ex) {
360    die($ex);
361  }
362
363  # Close the pipe, then re-open it for the second daemon
364  close($rfh);
365  close($wfh);
366
367  unless (pipe($rfh, $wfh)) {
368    die("Can't open pipe: $!");
369  }
370
371  # Fork child
372  defined($pid = fork()) or die("Can't fork: $!");
373  if ($pid) {
374    eval {
375      # Now try again with the correct info; we should be banned.  Note
376      # that we have to create a separate connection for this.
377
378      # Give the server some time to start up.
379      sleep(2);
380
381      eval { ProFTPD::TestSuite::FTP->new('127.0.0.1', $port, undef, 0); };
382      unless ($@) {
383        die("Connect succeeded unexpectedly");
384      }
385
386      my $conn_ex = ProFTPD::TestSuite::FTP::get_connect_exception();
387
388      # If we see an exception of "Net::FTP: connect: Connection refused",
389      # it means that the daemon hadn't even started up yet, which is not
390      # the same as listening but rejecting our connection.
391
392      my $expected = '';
393      $self->assert($expected eq $conn_ex,
394        test_msg("Expected '$expected', got '$conn_ex'"));
395    };
396
397    if ($@) {
398      $ex = $@;
399    }
400
401    $wfh->print("done\n");
402    $wfh->flush();
403
404  } else {
405    eval { server_wait($setup->{config_file}, $rfh) };
406    if ($@) {
407      warn($@);
408      exit 1;
409    }
410
411    exit 0;
412  }
413
414  # Stop server
415  server_stop($setup->{pid_file});
416
417  $self->assert_child_ok($pid);
418
419  test_cleanup($setup->{log_file}, $ex);
420}
421
4221;
423