1package ProFTPD::Tests::Modules::mod_sftp::rewrite;
2
3use lib qw(t/lib);
4use base qw(ProFTPD::TestSuite::Child);
5use strict;
6
7use Digest::MD5;
8use File::Copy;
9use File::Path qw(mkpath rmtree);
10use File::Spec;
11use IO::Handle;
12use IPC::Open3;
13use POSIX qw(:fcntl_h);
14use Socket;
15
16use ProFTPD::TestSuite::FTP;
17use ProFTPD::TestSuite::Utils qw(:auth :config :features :running :test :testsuite);
18
19$| = 1;
20
21my $order = 0;
22
23my $TESTS = {
24  ssh2_rewrite_auth => {
25    order => ++$order,
26    test_class => [qw(forking mod_rewrite ssh2)],
27  },
28
29  sftp_rewrite_stat => {
30    order => ++$order,
31    test_class => [qw(forking mod_rewrite sftp ssh2)],
32  },
33
34  sftp_rewrite_lstat => {
35    order => ++$order,
36    test_class => [qw(forking mod_rewrite sftp ssh2)],
37  },
38
39  sftp_rewrite_setstat => {
40    order => ++$order,
41    test_class => [qw(forking mod_rewrite sftp ssh2)],
42  },
43
44  sftp_rewrite_realpath => {
45    order => ++$order,
46    test_class => [qw(forking mod_rewrite sftp ssh2)],
47  },
48
49  sftp_rewrite_realpath_backslashes_bug4017 => {
50    order => ++$order,
51    test_class => [qw(bug forking mod_rewrite sftp ssh2)],
52  },
53
54  sftp_rewrite_upload => {
55    order => ++$order,
56    test_class => [qw(forking mod_rewrite sftp ssh2)],
57  },
58
59  sftp_rewrite_download => {
60    order => ++$order,
61    test_class => [qw(forking mod_rewrite sftp ssh2)],
62  },
63
64  sftp_rewrite_readdir => {
65    order => ++$order,
66    test_class => [qw(forking mod_rewrite sftp ssh2)],
67  },
68
69  sftp_rewrite_mkdir => {
70    order => ++$order,
71    test_class => [qw(forking mod_rewrite sftp ssh2)],
72  },
73
74  sftp_rewrite_rmdir => {
75    order => ++$order,
76    test_class => [qw(forking mod_rewrite sftp ssh2)],
77  },
78
79  sftp_rewrite_remove => {
80    order => ++$order,
81    test_class => [qw(forking mod_rewrite sftp ssh2)],
82  },
83
84  sftp_rewrite_rename => {
85    order => ++$order,
86    test_class => [qw(forking mod_rewrite sftp ssh2)],
87  },
88
89  sftp_rewrite_rename_file_var_w_bug3643 => {
90    order => ++$order,
91    test_class => [qw(forking mod_rewrite sftp ssh2)],
92  },
93
94  sftp_rewrite_rename_dir_var_w_bug3643 => {
95    order => ++$order,
96    test_class => [qw(forking mod_rewrite sftp ssh2)],
97  },
98
99  sftp_rewrite_symlink => {
100    order => ++$order,
101    test_class => [qw(forking mod_rewrite sftp ssh2)],
102  },
103
104  sftp_rewrite_readlink => {
105    order => ++$order,
106    test_class => [qw(forking mod_rewrite sftp ssh2)],
107  },
108
109  sftp_rewrite_homedir => {
110    order => ++$order,
111    test_class => [qw(forking mod_rewrite sftp ssh2)],
112  },
113
114  scp_rewrite_upload => {
115    order => ++$order,
116    test_class => [qw(forking mod_rewrite scp ssh2)],
117  },
118
119  scp_rewrite_download => {
120    order => ++$order,
121    test_class => [qw(forking mod_rewrite scp ssh2)],
122  },
123
124};
125
126sub get_sftplog {
127  my $db_file = shift;
128
129  my $sql = "SELECT user, operation, filename, full_path, filesize, xfertime FROM sftplog";
130
131  my $cmd = "sqlite3 $db_file \"$sql\"";
132
133  if ($ENV{TEST_VERBOSE}) {
134    print STDERR "Executing sqlite3: $cmd\n";
135  }
136
137  my $res = join('', `$cmd`);
138
139  # The default sqlite3 delimiter is '|'
140  return split(/\|/, $res);
141}
142
143sub new {
144  return shift()->SUPER::new(@_);
145}
146
147sub list_tests {
148  # Check for the required Perl modules:
149  #
150  #  Net-SSH2
151  #  Net-SSH2-SFTP
152
153  my $required = [qw(
154    Net::SSH2
155    Net::SSH2::SFTP
156  )];
157
158  foreach my $req (@$required) {
159    eval "use $req";
160    if ($@) {
161      print STDERR "\nWARNING:\n + Module '$req' not found, skipping all tests\n";
162
163      if ($ENV{TEST_VERBOSE}) {
164        print STDERR "Unable to load $req: $@\n";
165      }
166
167      return qw(testsuite_empty_test);
168    }
169  }
170
171  return testsuite_get_runnable_tests($TESTS);
172}
173
174sub set_up {
175  my $self = shift;
176  $self->SUPER::set_up(@_);
177
178  # Make sure that mod_sftp does not complain about permissions on the hostkey
179  # files.
180
181  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
182  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
183
184  unless (chmod(0400, $rsa_host_key, $dsa_host_key)) {
185    die("Can't set perms on $rsa_host_key, $dsa_host_key: $!");
186  }
187}
188
189sub ssh2_rewrite_auth {
190  my $self = shift;
191  my $tmpdir = $self->{tmpdir};
192
193  my $config_file = "$tmpdir/sftp.conf";
194  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
195  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
196
197  my $log_file = test_get_logfile();
198
199  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
200  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
201
202  my $user = 'proftpd';
203  my $passwd = 'test';
204  my $group = 'ftpd';
205  my $home_dir = File::Spec->rel2abs($tmpdir);
206  my $uid = 500;
207  my $gid = 500;
208
209  # Make sure that, if we're running as root, that the home directory has
210  # permissions/privs set for the account we create
211  if ($< == 0) {
212    unless (chmod(0755, $home_dir)) {
213      die("Can't set perms on $home_dir to 0755: $!");
214    }
215
216    unless (chown($uid, $gid, $home_dir)) {
217      die("Can't set owner of $home_dir to $uid/$gid: $!");
218    }
219  }
220
221  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
222    '/bin/bash');
223  auth_group_write($auth_group_file, $group, $gid, $user);
224
225  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
226  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
227
228  my $config = {
229    PidFile => $pid_file,
230    ScoreboardFile => $scoreboard_file,
231    SystemLog => $log_file,
232    TraceLog => $log_file,
233    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
234
235    AuthUserFile => $auth_user_file,
236    AuthGroupFile => $auth_group_file,
237
238    IfModules => {
239      'mod_delay.c' => {
240        DelayEngine => 'off',
241      },
242
243      'mod_rewrite.c' => [
244        'RewriteEngine on',
245        "RewriteLog $log_file",
246
247        'RewriteMap lowercase int:tolower',
248        'RewriteCondition %m USER',
249        'RewriteRule ^(.*)$ ${lowercase:$1}',
250      ],
251
252      'mod_sftp.c' => [
253        "SFTPEngine on",
254        "SFTPLog $log_file",
255        "SFTPHostKey $rsa_host_key",
256        "SFTPHostKey $dsa_host_key",
257      ],
258    },
259  };
260
261  my ($port, $config_user, $config_group) = config_write($config_file, $config);
262
263  # Open pipes, for use between the parent and child processes.  Specifically,
264  # the child will indicate when it's done with its test by writing a message
265  # to the parent.
266  my ($rfh, $wfh);
267  unless (pipe($rfh, $wfh)) {
268    die("Can't open pipe: $!");
269  }
270
271  require Net::SSH2;
272
273  my $ex;
274
275  # Fork child
276  $self->handle_sigchld();
277  defined(my $pid = fork()) or die("Can't fork: $!");
278  if ($pid) {
279    eval {
280      my $ssh2 = Net::SSH2->new();
281
282      sleep(1);
283
284      unless ($ssh2->connect('127.0.0.1', $port)) {
285        my ($err_code, $err_name, $err_str) = $ssh2->error();
286        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
287      }
288
289      unless ($ssh2->auth_password(uc($user), $passwd)) {
290        my ($err_code, $err_name, $err_str) = $ssh2->error();
291        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
292      }
293
294      $ssh2->disconnect();
295    };
296
297    if ($@) {
298      $ex = $@;
299    }
300
301    $wfh->print("done\n");
302    $wfh->flush();
303
304  } else {
305    eval { server_wait($config_file, $rfh) };
306    if ($@) {
307      warn($@);
308      exit 1;
309    }
310
311    exit 0;
312  }
313
314  # Stop server
315  server_stop($pid_file);
316
317  $self->assert_child_ok($pid);
318
319  if ($ex) {
320    test_append_logfile($log_file, $ex);
321    unlink($log_file);
322
323    die($ex);
324  }
325
326  unlink($log_file);
327}
328
329sub sftp_rewrite_stat {
330  my $self = shift;
331  my $tmpdir = $self->{tmpdir};
332
333  my $config_file = "$tmpdir/sftp.conf";
334  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
335  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
336
337  my $log_file = test_get_logfile();
338
339  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
340  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
341
342  my $user = 'proftpd';
343  my $passwd = 'test';
344  my $group = 'ftpd';
345  my $home_dir = File::Spec->rel2abs($tmpdir);
346  my $uid = 500;
347  my $gid = 500;
348
349  my $test_file = 'test_file_here.txt';
350  my $test_path = File::Spec->rel2abs("$tmpdir/$test_file");
351
352  if (open(my $fh, "> $test_path")) {
353    print $fh "Hello, World!\n";
354
355    unless (close($fh)) {
356      die("Can't write $test_path: $!");
357    }
358
359  } else {
360    die("Can't open $test_path: $!");
361  }
362
363  # Make sure that, if we're running as root, that the home directory has
364  # permissions/privs set for the account we create
365  if ($< == 0) {
366    unless (chmod(0755, $home_dir)) {
367      die("Can't set perms on $home_dir to 0755: $!");
368    }
369
370    unless (chown($uid, $gid, $home_dir)) {
371      die("Can't set owner of $home_dir to $uid/$gid: $!");
372    }
373  }
374
375  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
376    '/bin/bash');
377  auth_group_write($auth_group_file, $group, $gid, $user);
378
379  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
380  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
381
382  my $config = {
383    PidFile => $pid_file,
384    ScoreboardFile => $scoreboard_file,
385    SystemLog => $log_file,
386    TraceLog => $log_file,
387    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
388
389    AuthUserFile => $auth_user_file,
390    AuthGroupFile => $auth_group_file,
391
392    IfModules => {
393      'mod_delay.c' => {
394        DelayEngine => 'off',
395      },
396
397      'mod_rewrite.c' => [
398        'RewriteEngine on',
399        "RewriteLog $log_file",
400
401        'RewriteMap replace int:replaceall',
402        'RewriteCondition %m STAT',
403        'RewriteRule ^(.*) "${replace:!$1! !_}"',
404      ],
405
406      'mod_sftp.c' => [
407        "SFTPEngine on",
408        "SFTPLog $log_file",
409        "SFTPHostKey $rsa_host_key",
410        "SFTPHostKey $dsa_host_key",
411      ],
412    },
413  };
414
415  my ($port, $config_user, $config_group) = config_write($config_file, $config);
416
417  my $config_size = (stat($config_file))[7];
418
419  # Open pipes, for use between the parent and child processes.  Specifically,
420  # the child will indicate when it's done with its test by writing a message
421  # to the parent.
422  my ($rfh, $wfh);
423  unless (pipe($rfh, $wfh)) {
424    die("Can't open pipe: $!");
425  }
426
427  require Net::SSH2;
428
429  my $ex;
430
431  # Fork child
432  $self->handle_sigchld();
433  defined(my $pid = fork()) or die("Can't fork: $!");
434  if ($pid) {
435    eval {
436      my $ssh2 = Net::SSH2->new();
437
438      sleep(1);
439
440      unless ($ssh2->connect('127.0.0.1', $port)) {
441        my ($err_code, $err_name, $err_str) = $ssh2->error();
442        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
443      }
444
445      unless ($ssh2->auth_password($user, $passwd)) {
446        my ($err_code, $err_name, $err_str) = $ssh2->error();
447        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
448      }
449
450      my $sftp = $ssh2->sftp();
451      unless ($sftp) {
452        my ($err_code, $err_name, $err_str) = $ssh2->error();
453        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
454      }
455
456      my $attrs = $sftp->stat('test file here.txt', 1);
457      unless ($attrs) {
458        my ($err_code, $err_name) = $sftp->error();
459        die("FXP_STAT failed: [$err_name] ($err_code)");
460      }
461
462      my $expected;
463
464      $expected = 14;
465      my $file_size = $attrs->{size};
466      $self->assert($expected == $file_size,
467        test_msg("Expected '$expected', got '$file_size'"));
468
469      $expected = $<;
470      my $file_uid = $attrs->{uid};
471      $self->assert($expected == $file_uid,
472        test_msg("Expected '$expected', got '$file_uid'"));
473
474      $expected = $(;
475      my $file_gid = $attrs->{gid};
476      $self->assert($expected == $file_gid,
477        test_msg("Expected '$expected', got '$file_gid'"));
478
479      $ssh2->disconnect();
480    };
481
482    if ($@) {
483      $ex = $@;
484    }
485
486    $wfh->print("done\n");
487    $wfh->flush();
488
489  } else {
490    eval { server_wait($config_file, $rfh) };
491    if ($@) {
492      warn($@);
493      exit 1;
494    }
495
496    exit 0;
497  }
498
499  # Stop server
500  server_stop($pid_file);
501
502  $self->assert_child_ok($pid);
503
504  if ($ex) {
505    test_append_logfile($log_file, $ex);
506    unlink($log_file);
507
508    die($ex);
509  }
510
511  unlink($log_file);
512}
513
514sub sftp_rewrite_lstat {
515  my $self = shift;
516  my $tmpdir = $self->{tmpdir};
517
518  my $config_file = "$tmpdir/sftp.conf";
519  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
520  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
521
522  my $log_file = test_get_logfile();
523
524  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
525  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
526
527  my $user = 'proftpd';
528  my $passwd = 'test';
529  my $group = 'ftpd';
530  my $home_dir = File::Spec->rel2abs($tmpdir);
531  my $uid = 500;
532  my $gid = 500;
533
534  # Make sure that, if we're running as root, that the home directory has
535  # permissions/privs set for the account we create
536  if ($< == 0) {
537    unless (chmod(0755, $home_dir)) {
538      die("Can't set perms on $home_dir to 0755: $!");
539    }
540
541    unless (chown($uid, $gid, $home_dir)) {
542      die("Can't set owner of $home_dir to $uid/$gid: $!");
543    }
544  }
545
546  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
547    '/bin/bash');
548  auth_group_write($auth_group_file, $group, $gid, $user);
549
550  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
551  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
552
553  my $config = {
554    PidFile => $pid_file,
555    ScoreboardFile => $scoreboard_file,
556    SystemLog => $log_file,
557    TraceLog => $log_file,
558    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
559
560    AuthUserFile => $auth_user_file,
561    AuthGroupFile => $auth_group_file,
562
563    IfModules => {
564      'mod_delay.c' => {
565        DelayEngine => 'off',
566      },
567
568      'mod_rewrite.c' => [
569        'RewriteEngine on',
570        "RewriteLog $log_file",
571
572        'RewriteMap replace int:replaceall',
573        'RewriteCondition %m LSTAT',
574        'RewriteRule ^(.*) "${replace:!$1! !_}"',
575      ],
576
577      'mod_sftp.c' => [
578        "SFTPEngine on",
579        "SFTPLog $log_file",
580        "SFTPHostKey $rsa_host_key",
581        "SFTPHostKey $dsa_host_key",
582      ],
583    },
584  };
585
586  my ($port, $config_user, $config_group) = config_write($config_file, $config);
587
588  my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt");
589  if (open(my $fh, "> $test_file")) {
590    print $fh "ABCD" x 1024;
591    unless (close($fh)) {
592      die("Can't write $test_file: $!");
593    }
594
595  } else {
596    die("Can't open $test_file: $!");
597  }
598
599  my $test_symlink = File::Spec->rel2abs("$tmpdir/test_link");
600  unless (symlink($test_file, $test_symlink)) {
601    die("Can't symlink $test_symlink to $test_file: $!");
602  }
603
604  my $test_size = (lstat($test_symlink))[7];
605
606  # Open pipes, for use between the parent and child processes.  Specifically,
607  # the child will indicate when it's done with its test by writing a message
608  # to the parent.
609  my ($rfh, $wfh);
610  unless (pipe($rfh, $wfh)) {
611    die("Can't open pipe: $!");
612  }
613
614  require Net::SSH2;
615
616  my $ex;
617
618  # Fork child
619  $self->handle_sigchld();
620  defined(my $pid = fork()) or die("Can't fork: $!");
621  if ($pid) {
622    eval {
623      my $ssh2 = Net::SSH2->new();
624
625      sleep(1);
626
627      unless ($ssh2->connect('127.0.0.1', $port)) {
628        my ($err_code, $err_name, $err_str) = $ssh2->error();
629        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
630      }
631
632      unless ($ssh2->auth_password($user, $passwd)) {
633        my ($err_code, $err_name, $err_str) = $ssh2->error();
634        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
635      }
636
637      my $sftp = $ssh2->sftp();
638      unless ($sftp) {
639        my ($err_code, $err_name, $err_str) = $ssh2->error();
640        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
641      }
642
643      my $attrs = $sftp->stat('test link', 0);
644      unless ($attrs) {
645        my ($err_code, $err_name) = $sftp->error();
646        die("FXP_LSTAT failed: [$err_name] ($err_code)");
647      }
648
649      my $expected;
650
651      $expected = $test_size;
652      my $file_size = $attrs->{size};
653      $self->assert($expected == $file_size,
654        test_msg("Expected '$expected', got '$file_size'"));
655
656      $expected = $<;
657      my $file_uid = $attrs->{uid};
658      $self->assert($expected == $file_uid,
659        test_msg("Expected '$expected', got '$file_uid'"));
660
661      $expected = $(;
662      my $file_gid = $attrs->{gid};
663      $self->assert($expected == $file_gid,
664        test_msg("Expected '$expected', got '$file_gid'"));
665
666      $ssh2->disconnect();
667    };
668
669    if ($@) {
670      $ex = $@;
671    }
672
673    $wfh->print("done\n");
674    $wfh->flush();
675
676  } else {
677    eval { server_wait($config_file, $rfh) };
678    if ($@) {
679      warn($@);
680      exit 1;
681    }
682
683    exit 0;
684  }
685
686  # Stop server
687  server_stop($pid_file);
688
689  $self->assert_child_ok($pid);
690
691  if ($ex) {
692    test_append_logfile($log_file, $ex);
693    unlink($log_file);
694
695    die($ex);
696  }
697
698  unlink($log_file);
699}
700
701sub sftp_rewrite_setstat {
702  my $self = shift;
703  my $tmpdir = $self->{tmpdir};
704
705  my $config_file = "$tmpdir/sftp.conf";
706  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
707  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
708
709  my $log_file = test_get_logfile();
710
711  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
712  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
713
714  my $user = 'proftpd';
715  my $passwd = 'test';
716  my $group = 'ftpd';
717  my $home_dir = File::Spec->rel2abs($tmpdir);
718  my $uid = 500;
719  my $gid = 500;
720
721  # Make sure that, if we're running as root, that the home directory has
722  # permissions/privs set for the account we create
723  if ($< == 0) {
724    unless (chmod(0755, $home_dir)) {
725      die("Can't set perms on $home_dir to 0755: $!");
726    }
727
728    unless (chown($uid, $gid, $home_dir)) {
729      die("Can't set owner of $home_dir to $uid/$gid: $!");
730    }
731  }
732
733  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
734    '/bin/bash');
735  auth_group_write($auth_group_file, $group, $gid, $user);
736
737  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
738  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
739
740  my $config = {
741    PidFile => $pid_file,
742    ScoreboardFile => $scoreboard_file,
743    SystemLog => $log_file,
744    TraceLog => $log_file,
745    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
746
747    AuthUserFile => $auth_user_file,
748    AuthGroupFile => $auth_group_file,
749
750    IfModules => {
751      'mod_delay.c' => {
752        DelayEngine => 'off',
753      },
754
755      'mod_rewrite.c' => [
756        'RewriteEngine on',
757        "RewriteLog $log_file",
758
759        'RewriteMap replace int:replaceall',
760        'RewriteCondition %m ^(STAT|SETSTAT)$',
761        'RewriteRule ^(.*) "${replace:!$1! !_}"',
762      ],
763
764      'mod_sftp.c' => [
765        "SFTPEngine on",
766        "SFTPLog $log_file",
767        "SFTPHostKey $rsa_host_key",
768        "SFTPHostKey $dsa_host_key",
769      ],
770    },
771  };
772
773  my ($port, $config_user, $config_group) = config_write($config_file, $config);
774
775  my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt");
776  if (open(my $fh, "> $test_file")) {
777    print $fh "ABCD" x 1024;
778    unless (close($fh)) {
779      die("Can't write $test_file: $!");
780    }
781
782  } else {
783    die("Can't open $test_file: $!");
784  }
785
786  # Open pipes, for use between the parent and child processes.  Specifically,
787  # the child will indicate when it's done with its test by writing a message
788  # to the parent.
789  my ($rfh, $wfh);
790  unless (pipe($rfh, $wfh)) {
791    die("Can't open pipe: $!");
792  }
793
794  require Net::SSH2;
795
796  my $ex;
797
798  # Fork child
799  $self->handle_sigchld();
800  defined(my $pid = fork()) or die("Can't fork: $!");
801  if ($pid) {
802    eval {
803      my $ssh2 = Net::SSH2->new();
804
805      sleep(1);
806
807      unless ($ssh2->connect('127.0.0.1', $port)) {
808        my ($err_code, $err_name, $err_str) = $ssh2->error();
809        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
810      }
811
812      unless ($ssh2->auth_password($user, $passwd)) {
813        my ($err_code, $err_name, $err_str) = $ssh2->error();
814        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
815      }
816
817      my $sftp = $ssh2->sftp();
818      unless ($sftp) {
819        my ($err_code, $err_name, $err_str) = $ssh2->error();
820        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
821      }
822
823      my $res = $sftp->setstat('test file.txt',
824        atime => 0,
825        mtime => 0,
826      );
827      unless ($res) {
828        my ($err_code, $err_name) = $sftp->error();
829        die("FXP_SETSTAT failed: [$err_name] ($err_code)");
830      }
831
832      my $attrs = $sftp->stat('test file.txt');
833      unless ($attrs) {
834        my ($err_code, $err_name) = $sftp->error();
835        die("FXP_STAT failed: [$err_name] ($err_code)");
836      }
837
838      $ssh2->disconnect();
839
840      my $expected;
841
842      $expected = 0;
843      my $file_atime = $attrs->{atime};
844      $self->assert($expected == $file_atime,
845        test_msg("Expected '$expected', got '$file_atime'"));
846
847      my $file_mtime = $attrs->{mtime};
848      $self->assert($expected == $file_mtime,
849        test_msg("Expected '$expected', got '$file_mtime'"));
850    };
851
852    if ($@) {
853      $ex = $@;
854    }
855
856    $wfh->print("done\n");
857    $wfh->flush();
858
859  } else {
860    eval { server_wait($config_file, $rfh) };
861    if ($@) {
862      warn($@);
863      exit 1;
864    }
865
866    exit 0;
867  }
868
869  # Stop server
870  server_stop($pid_file);
871
872  $self->assert_child_ok($pid);
873
874  if ($ex) {
875    test_append_logfile($log_file, $ex);
876    unlink($log_file);
877
878    die($ex);
879  }
880
881  unlink($log_file);
882}
883
884sub sftp_rewrite_realpath {
885  my $self = shift;
886  my $tmpdir = $self->{tmpdir};
887
888  my $config_file = "$tmpdir/sftp.conf";
889  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
890  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
891
892  my $log_file = test_get_logfile();
893
894  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
895  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
896
897  my $user = 'proftpd';
898  my $passwd = 'test';
899  my $group = 'ftpd';
900  my $home_dir = File::Spec->rel2abs($tmpdir);
901  my $uid = 500;
902  my $gid = 500;
903
904  # Make sure that, if we're running as root, that the home directory has
905  # permissions/privs set for the account we create
906  if ($< == 0) {
907    unless (chmod(0755, $home_dir)) {
908      die("Can't set perms on $home_dir to 0755: $!");
909    }
910
911    unless (chown($uid, $gid, $home_dir)) {
912      die("Can't set owner of $home_dir to $uid/$gid: $!");
913    }
914  }
915
916  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
917    '/bin/bash');
918  auth_group_write($auth_group_file, $group, $gid, $user);
919
920  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
921  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
922
923  my $config = {
924    PidFile => $pid_file,
925    ScoreboardFile => $scoreboard_file,
926    SystemLog => $log_file,
927    TraceLog => $log_file,
928    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
929
930    AuthUserFile => $auth_user_file,
931    AuthGroupFile => $auth_group_file,
932
933    IfModules => {
934      'mod_delay.c' => {
935        DelayEngine => 'off',
936      },
937
938      'mod_rewrite.c' => [
939        'RewriteEngine on',
940        "RewriteLog $log_file",
941
942        'RewriteMap replace int:replaceall',
943        'RewriteCondition %m REALPATH',
944        'RewriteRule ^(.*) "${replace:!$1! !_}"',
945      ],
946
947      'mod_sftp.c' => [
948        "SFTPEngine on",
949        "SFTPLog $log_file",
950        "SFTPHostKey $rsa_host_key",
951        "SFTPHostKey $dsa_host_key",
952      ],
953    },
954  };
955
956  my ($port, $config_user, $config_group) = config_write($config_file, $config);
957
958  my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt");
959  if (open(my $fh, "> $test_file")) {
960    unless (close($fh)) {
961      die("Can't write $test_file: $!");
962    }
963
964  } else {
965    die("Can't open $test_file: $!");
966  }
967
968  # Open pipes, for use between the parent and child processes.  Specifically,
969  # the child will indicate when it's done with its test by writing a message
970  # to the parent.
971  my ($rfh, $wfh);
972  unless (pipe($rfh, $wfh)) {
973    die("Can't open pipe: $!");
974  }
975
976  require Net::SSH2;
977
978  my $ex;
979
980  # Fork child
981  $self->handle_sigchld();
982  defined(my $pid = fork()) or die("Can't fork: $!");
983  if ($pid) {
984    eval {
985      my $ssh2 = Net::SSH2->new();
986
987      sleep(1);
988
989      unless ($ssh2->connect('127.0.0.1', $port)) {
990        my ($err_code, $err_name, $err_str) = $ssh2->error();
991        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
992      }
993
994      unless ($ssh2->auth_password($user, $passwd)) {
995        my ($err_code, $err_name, $err_str) = $ssh2->error();
996        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
997      }
998
999      my $sftp = $ssh2->sftp();
1000      unless ($sftp) {
1001        my ($err_code, $err_name, $err_str) = $ssh2->error();
1002        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
1003      }
1004
1005      my $resolved = $sftp->realpath('test file.txt');
1006      unless ($resolved) {
1007        my ($err_code, $err_name) = $sftp->error();
1008        die("FXP_REALPATH failed: [$err_name] ($err_code)");
1009      }
1010
1011      my $expected;
1012
1013      $expected = $test_file;
1014      if ($^O eq 'darwin') {
1015        # Mac OSX hack
1016        $expected = '/private' . $expected;
1017      }
1018
1019      $self->assert($expected eq $resolved,
1020        test_msg("Expected '$expected', got '$resolved'"));
1021
1022      $ssh2->disconnect();
1023    };
1024
1025    if ($@) {
1026      $ex = $@;
1027    }
1028
1029    $wfh->print("done\n");
1030    $wfh->flush();
1031
1032  } else {
1033    eval { server_wait($config_file, $rfh) };
1034    if ($@) {
1035      warn($@);
1036      exit 1;
1037    }
1038
1039    exit 0;
1040  }
1041
1042  # Stop server
1043  server_stop($pid_file);
1044
1045  $self->assert_child_ok($pid);
1046
1047  if ($ex) {
1048    test_append_logfile($log_file, $ex);
1049    unlink($log_file);
1050
1051    die($ex);
1052  }
1053
1054  unlink($log_file);
1055}
1056
1057sub sftp_rewrite_realpath_backslashes_bug4017 {
1058  my $self = shift;
1059  my $tmpdir = $self->{tmpdir};
1060
1061  my $config_file = "$tmpdir/sftp.conf";
1062  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
1063  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
1064
1065  my $log_file = test_get_logfile();
1066
1067  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
1068  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
1069
1070  my $user = 'proftpd';
1071  my $passwd = 'test';
1072  my $group = 'ftpd';
1073  my $home_dir = File::Spec->rel2abs($tmpdir);
1074  my $uid = 500;
1075  my $gid = 500;
1076
1077  # Make sure that, if we're running as root, that the home directory has
1078  # permissions/privs set for the account we create
1079  if ($< == 0) {
1080    unless (chmod(0755, $home_dir)) {
1081      die("Can't set perms on $home_dir to 0755: $!");
1082    }
1083
1084    unless (chown($uid, $gid, $home_dir)) {
1085      die("Can't set owner of $home_dir to $uid/$gid: $!");
1086    }
1087  }
1088
1089  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
1090    '/bin/bash');
1091  auth_group_write($auth_group_file, $group, $gid, $user);
1092
1093  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
1094  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
1095
1096  my $config = {
1097    PidFile => $pid_file,
1098    ScoreboardFile => $scoreboard_file,
1099    SystemLog => $log_file,
1100    TraceLog => $log_file,
1101    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
1102
1103    AuthUserFile => $auth_user_file,
1104    AuthGroupFile => $auth_group_file,
1105
1106    IfModules => {
1107      'mod_delay.c' => {
1108        DelayEngine => 'off',
1109      },
1110
1111      'mod_rewrite.c' => [
1112        'RewriteEngine on',
1113        "RewriteLog $log_file",
1114
1115        'RewriteMap replace int:replaceall',
1116        'RewriteCondition %m REALPATH',
1117        'RewriteRule (.*) "${replace:!$1!\\\\!/}"',
1118      ],
1119
1120      'mod_sftp.c' => [
1121        "SFTPEngine on",
1122        "SFTPLog $log_file",
1123        "SFTPHostKey $rsa_host_key",
1124        "SFTPHostKey $dsa_host_key",
1125      ],
1126    },
1127  };
1128
1129  my ($port, $config_user, $config_group) = config_write($config_file, $config);
1130
1131  my $test_file = File::Spec->rel2abs("$tmpdir/test.txt");
1132  if (open(my $fh, "> $test_file")) {
1133    unless (close($fh)) {
1134      die("Can't write $test_file: $!");
1135    }
1136
1137  } else {
1138    die("Can't open $test_file: $!");
1139  }
1140
1141  # Open pipes, for use between the parent and child processes.  Specifically,
1142  # the child will indicate when it's done with its test by writing a message
1143  # to the parent.
1144  my ($rfh, $wfh);
1145  unless (pipe($rfh, $wfh)) {
1146    die("Can't open pipe: $!");
1147  }
1148
1149  require Net::SSH2;
1150
1151  my $ex;
1152
1153  # Fork child
1154  $self->handle_sigchld();
1155  defined(my $pid = fork()) or die("Can't fork: $!");
1156  if ($pid) {
1157    eval {
1158      my $ssh2 = Net::SSH2->new();
1159
1160      sleep(1);
1161
1162      unless ($ssh2->connect('127.0.0.1', $port)) {
1163        my ($err_code, $err_name, $err_str) = $ssh2->error();
1164        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
1165      }
1166
1167      unless ($ssh2->auth_password($user, $passwd)) {
1168        my ($err_code, $err_name, $err_str) = $ssh2->error();
1169        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
1170      }
1171
1172      my $sftp = $ssh2->sftp();
1173      unless ($sftp) {
1174        my ($err_code, $err_name, $err_str) = $ssh2->error();
1175        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
1176      }
1177
1178      my $munged = $test_file;
1179      $munged =~ s/\//\\/g;
1180
1181      my $resolved = $sftp->realpath($munged);
1182      unless ($resolved) {
1183        my ($err_code, $err_name) = $sftp->error();
1184        die("FXP_REALPATH failed: [$err_name] ($err_code)");
1185      }
1186
1187      my $expected;
1188
1189      $expected = $test_file;
1190      if ($^O eq 'darwin') {
1191        # Mac OSX hack
1192        $expected = '/private' . $expected;
1193      }
1194
1195      $self->assert($expected eq $resolved,
1196        test_msg("Expected '$expected', got '$resolved'"));
1197
1198      $ssh2->disconnect();
1199    };
1200
1201    if ($@) {
1202      $ex = $@;
1203    }
1204
1205    $wfh->print("done\n");
1206    $wfh->flush();
1207
1208  } else {
1209    eval { server_wait($config_file, $rfh) };
1210    if ($@) {
1211      warn($@);
1212      exit 1;
1213    }
1214
1215    exit 0;
1216  }
1217
1218  # Stop server
1219  server_stop($pid_file);
1220
1221  $self->assert_child_ok($pid);
1222
1223  if ($ex) {
1224    test_append_logfile($log_file, $ex);
1225    unlink($log_file);
1226
1227    die($ex);
1228  }
1229
1230  unlink($log_file);
1231}
1232
1233sub sftp_rewrite_upload {
1234  my $self = shift;
1235  my $tmpdir = $self->{tmpdir};
1236
1237  my $config_file = "$tmpdir/sftp.conf";
1238  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
1239  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
1240
1241  my $log_file = test_get_logfile();
1242
1243  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
1244  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
1245
1246  my $user = 'proftpd';
1247  my $passwd = 'test';
1248  my $group = 'ftpd';
1249  my $home_dir = File::Spec->rel2abs($tmpdir);
1250  my $uid = 500;
1251  my $gid = 500;
1252
1253  # Make sure that, if we're running as root, that the home directory has
1254  # permissions/privs set for the account we create
1255  if ($< == 0) {
1256    unless (chmod(0755, $home_dir)) {
1257      die("Can't set perms on $home_dir to 0755: $!");
1258    }
1259
1260    unless (chown($uid, $gid, $home_dir)) {
1261      die("Can't set owner of $home_dir to $uid/$gid: $!");
1262    }
1263  }
1264
1265  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
1266    '/bin/bash');
1267  auth_group_write($auth_group_file, $group, $gid, $user);
1268
1269  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
1270  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
1271
1272  my $config = {
1273    PidFile => $pid_file,
1274    ScoreboardFile => $scoreboard_file,
1275    SystemLog => $log_file,
1276    TraceLog => $log_file,
1277    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
1278
1279    AuthUserFile => $auth_user_file,
1280    AuthGroupFile => $auth_group_file,
1281
1282    IfModules => {
1283      'mod_delay.c' => {
1284        DelayEngine => 'off',
1285      },
1286
1287      'mod_rewrite.c' => [
1288        'RewriteEngine on',
1289        "RewriteLog $log_file",
1290
1291        'RewriteMap replace int:replaceall',
1292        'RewriteCondition %m STOR',
1293        'RewriteRule ^(.*) "${replace:!$1! !_}"',
1294      ],
1295
1296      'mod_sftp.c' => [
1297        "SFTPEngine on",
1298        "SFTPLog $log_file",
1299        "SFTPHostKey $rsa_host_key",
1300        "SFTPHostKey $dsa_host_key",
1301      ],
1302    },
1303  };
1304
1305  my ($port, $config_user, $config_group) = config_write($config_file, $config);
1306
1307  my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt");
1308
1309  # Open pipes, for use between the parent and child processes.  Specifically,
1310  # the child will indicate when it's done with its test by writing a message
1311  # to the parent.
1312  my ($rfh, $wfh);
1313  unless (pipe($rfh, $wfh)) {
1314    die("Can't open pipe: $!");
1315  }
1316
1317  require Net::SSH2;
1318
1319  my $ex;
1320
1321  # Ignore SIGPIPE
1322  local $SIG{PIPE} = sub { };
1323
1324  # Fork child
1325  $self->handle_sigchld();
1326  defined(my $pid = fork()) or die("Can't fork: $!");
1327  if ($pid) {
1328    eval {
1329      my $ssh2 = Net::SSH2->new();
1330
1331      sleep(1);
1332
1333      unless ($ssh2->connect('127.0.0.1', $port)) {
1334        my ($err_code, $err_name, $err_str) = $ssh2->error();
1335        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
1336      }
1337
1338      unless ($ssh2->auth_password($user, $passwd)) {
1339        my ($err_code, $err_name, $err_str) = $ssh2->error();
1340        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
1341      }
1342
1343      my $sftp = $ssh2->sftp();
1344      unless ($sftp) {
1345        my ($err_code, $err_name, $err_str) = $ssh2->error();
1346        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
1347      }
1348
1349      my $fh = $sftp->open('test file.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644);
1350      unless ($fh) {
1351        my ($err_code, $err_name) = $sftp->error();
1352        die("FXP_OPEN failed: [$err_name] ($err_code)");
1353      }
1354
1355      my $count = 20;
1356      for (my $i = 0; $i < $count; $i++) {
1357        print $fh "ABCD" x 8192;
1358      }
1359
1360      # To issue the FXP_CLOSE, we have to explicit destroy the filehandle
1361      $fh = undef;
1362
1363      $ssh2->disconnect();
1364
1365      # Make sure that the rewritten file is present
1366      $self->assert(-f $test_file, test_msg("File $test_file unexpectedly missing"));
1367    };
1368
1369    if ($@) {
1370      $ex = $@;
1371    }
1372
1373    $wfh->print("done\n");
1374    $wfh->flush();
1375
1376  } else {
1377    eval { server_wait($config_file, $rfh) };
1378    if ($@) {
1379      warn($@);
1380      exit 1;
1381    }
1382
1383    exit 0;
1384  }
1385
1386  # Stop server
1387  server_stop($pid_file);
1388
1389  $self->assert_child_ok($pid);
1390
1391  if ($ex) {
1392    test_append_logfile($log_file, $ex);
1393    unlink($log_file);
1394
1395    die($ex);
1396  }
1397
1398  unlink($log_file);
1399}
1400
1401sub sftp_rewrite_download {
1402  my $self = shift;
1403  my $tmpdir = $self->{tmpdir};
1404
1405  my $config_file = "$tmpdir/sftp.conf";
1406  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
1407  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
1408
1409  my $log_file = test_get_logfile();
1410
1411  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
1412  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
1413
1414  my $user = 'proftpd';
1415  my $passwd = 'test';
1416  my $group = 'ftpd';
1417  my $home_dir = File::Spec->rel2abs($tmpdir);
1418  my $uid = 500;
1419  my $gid = 500;
1420
1421  my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt");
1422  if (open(my $fh, "> $test_file")) {
1423    my $count = 20;
1424    for (my $i = 0; $i < $count; $i++) {
1425      print $fh "ABCD" x 8192;
1426    }
1427
1428    unless (close($fh)) {
1429      die("Can't write $test_file: $!");
1430    }
1431
1432  } else {
1433    die("Can't open $test_file: $!");
1434  }
1435
1436  my $test_sz = (stat($test_file))[7];
1437
1438  # Make sure that, if we're running as root, that the home directory has
1439  # permissions/privs set for the account we create
1440  if ($< == 0) {
1441    unless (chmod(0755, $home_dir)) {
1442      die("Can't set perms on $home_dir to 0755: $!");
1443    }
1444
1445    unless (chown($uid, $gid, $home_dir)) {
1446      die("Can't set owner of $home_dir to $uid/$gid: $!");
1447    }
1448  }
1449
1450  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
1451    '/bin/bash');
1452  auth_group_write($auth_group_file, $group, $gid, $user);
1453
1454  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
1455  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
1456
1457  my $config = {
1458    PidFile => $pid_file,
1459    ScoreboardFile => $scoreboard_file,
1460    SystemLog => $log_file,
1461    TraceLog => $log_file,
1462    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
1463
1464    AuthUserFile => $auth_user_file,
1465    AuthGroupFile => $auth_group_file,
1466
1467    IfModules => {
1468      'mod_delay.c' => {
1469        DelayEngine => 'off',
1470      },
1471
1472      'mod_rewrite.c' => [
1473        'RewriteEngine on',
1474        "RewriteLog $log_file",
1475
1476        'RewriteMap replace int:replaceall',
1477        'RewriteCondition %m RETR',
1478        'RewriteRule ^(.*) "${replace:!$1! !_}"',
1479      ],
1480
1481      'mod_sftp.c' => [
1482        "SFTPEngine on",
1483        "SFTPLog $log_file",
1484        "SFTPHostKey $rsa_host_key",
1485        "SFTPHostKey $dsa_host_key",
1486      ],
1487    },
1488  };
1489
1490  my ($port, $config_user, $config_group) = config_write($config_file, $config);
1491
1492  # Open pipes, for use between the parent and child processes.  Specifically,
1493  # the child will indicate when it's done with its test by writing a message
1494  # to the parent.
1495  my ($rfh, $wfh);
1496  unless (pipe($rfh, $wfh)) {
1497    die("Can't open pipe: $!");
1498  }
1499
1500  require Net::SSH2;
1501
1502  my $ex;
1503
1504  # Ignore SIGPIPE
1505  local $SIG{PIPE} = sub { };
1506
1507  # Fork child
1508  $self->handle_sigchld();
1509  defined(my $pid = fork()) or die("Can't fork: $!");
1510  if ($pid) {
1511    eval {
1512      my $ssh2 = Net::SSH2->new();
1513
1514      sleep(1);
1515
1516      unless ($ssh2->connect('127.0.0.1', $port)) {
1517        my ($err_code, $err_name, $err_str) = $ssh2->error();
1518        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
1519      }
1520
1521      unless ($ssh2->auth_password($user, $passwd)) {
1522        my ($err_code, $err_name, $err_str) = $ssh2->error();
1523        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
1524      }
1525
1526      my $sftp = $ssh2->sftp();
1527      unless ($sftp) {
1528        my ($err_code, $err_name, $err_str) = $ssh2->error();
1529        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
1530      }
1531
1532      my $fh = $sftp->open('test file.txt', O_RDONLY);
1533      unless ($fh) {
1534        my ($err_code, $err_name) = $sftp->error();
1535        die("FXP_OPEN failed: [$err_name] ($err_code)");
1536      }
1537
1538      my $buf;
1539      my $size = 0;
1540
1541      my $res = $fh->read($buf, 8192);
1542      while ($res) {
1543        $size += $res;
1544
1545        $res = $fh->read($buf, 8192);
1546      }
1547
1548      # To issue the FXP_CLOSE, we have to explicit destroy the filehandle
1549      $fh = undef;
1550
1551      $self->assert($test_sz == $size,
1552        test_msg("Expected $test_sz, got $size"));
1553
1554      $ssh2->disconnect();
1555    };
1556
1557    if ($@) {
1558      $ex = $@;
1559    }
1560
1561    $wfh->print("done\n");
1562    $wfh->flush();
1563
1564  } else {
1565    eval { server_wait($config_file, $rfh) };
1566    if ($@) {
1567      warn($@);
1568      exit 1;
1569    }
1570
1571    exit 0;
1572  }
1573
1574  # Stop server
1575  server_stop($pid_file);
1576
1577  $self->assert_child_ok($pid);
1578
1579  if ($ex) {
1580    test_append_logfile($log_file, $ex);
1581    unlink($log_file);
1582
1583    die($ex);
1584  }
1585
1586  unlink($log_file);
1587}
1588
1589sub sftp_rewrite_readdir {
1590  my $self = shift;
1591  my $tmpdir = $self->{tmpdir};
1592
1593  my $config_file = "$tmpdir/sftp.conf";
1594  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
1595  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
1596
1597  my $log_file = test_get_logfile();
1598
1599  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
1600  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
1601
1602  my $user = 'proftpd';
1603  my $passwd = 'test';
1604  my $group = 'ftpd';
1605  my $home_dir = File::Spec->rel2abs($tmpdir);
1606  my $uid = 500;
1607  my $gid = 500;
1608
1609  my $sub_dir = File::Spec->rel2abs("$tmpdir/sub_dir");
1610  mkpath($sub_dir);
1611
1612  my $test_file = File::Spec->rel2abs("$sub_dir/subfile.txt");
1613  if (open(my $fh, "> $test_file")) {
1614    close($fh);
1615
1616  } else {
1617    die("Can't open $test_file: $!");
1618  }
1619
1620  # Make sure that, if we're running as root, that the home directory has
1621  # permissions/privs set for the account we create
1622  if ($< == 0) {
1623    unless (chmod(0755, $home_dir)) {
1624      die("Can't set perms on $home_dir to 0755: $!");
1625    }
1626
1627    unless (chown($uid, $gid, $home_dir)) {
1628      die("Can't set owner of $home_dir to $uid/$gid: $!");
1629    }
1630  }
1631
1632  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
1633    '/bin/bash');
1634  auth_group_write($auth_group_file, $group, $gid, $user);
1635
1636  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
1637  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
1638
1639  my $config = {
1640    PidFile => $pid_file,
1641    ScoreboardFile => $scoreboard_file,
1642    SystemLog => $log_file,
1643    TraceLog => $log_file,
1644    Trace => 'auth:10 ssh2:20 sftp:20 scp:20',
1645
1646    AuthUserFile => $auth_user_file,
1647    AuthGroupFile => $auth_group_file,
1648
1649    IfModules => {
1650      'mod_delay.c' => {
1651        DelayEngine => 'off',
1652      },
1653
1654      'mod_rewrite.c' => [
1655        'RewriteEngine on',
1656        "RewriteLog $log_file",
1657
1658        'RewriteMap replace int:replaceall',
1659        'RewriteCondition %m OPENDIR',
1660        'RewriteRule ^(.*) "${replace:!$1! !_}"',
1661      ],
1662
1663      'mod_sftp.c' => [
1664        "SFTPEngine on",
1665        "SFTPLog $log_file",
1666        "SFTPHostKey $rsa_host_key",
1667        "SFTPHostKey $dsa_host_key",
1668      ],
1669    },
1670  };
1671
1672  my ($port, $config_user, $config_group) = config_write($config_file, $config);
1673
1674  # Open pipes, for use between the parent and child processes.  Specifically,
1675  # the child will indicate when it's done with its test by writing a message
1676  # to the parent.
1677  my ($rfh, $wfh);
1678  unless (pipe($rfh, $wfh)) {
1679    die("Can't open pipe: $!");
1680  }
1681
1682  require Net::SSH2;
1683
1684  my $ex;
1685
1686  # Fork child
1687  $self->handle_sigchld();
1688  defined(my $pid = fork()) or die("Can't fork: $!");
1689  if ($pid) {
1690    eval {
1691      my $ssh2 = Net::SSH2->new();
1692
1693      sleep(1);
1694
1695      unless ($ssh2->connect('127.0.0.1', $port)) {
1696        my ($err_code, $err_name, $err_str) = $ssh2->error();
1697        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
1698      }
1699
1700      unless ($ssh2->auth_password($user, $passwd)) {
1701        my ($err_code, $err_name, $err_str) = $ssh2->error();
1702        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
1703      }
1704
1705      my $sftp = $ssh2->sftp();
1706      unless ($sftp) {
1707        my ($err_code, $err_name, $err_str) = $ssh2->error();
1708        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
1709      }
1710
1711      my $dir = $sftp->opendir('sub dir');
1712      unless ($dir) {
1713        my ($err_code, $err_name) = $sftp->error();
1714        die("FXP_OPENDIR failed: [$err_name] ($err_code)");
1715      }
1716
1717      my $res = {};
1718
1719      my $file = $dir->read();
1720      while ($file) {
1721        $res->{$file->{name}} = $file;
1722        $file = $dir->read();
1723      }
1724
1725      my $expected = {
1726        '.' => 1,
1727        '..' => 1,
1728        'subfile.txt' => 1,
1729      };
1730
1731      # To issue the FXP_CLOSE, we have to explicit destroy the dirhandle
1732      $dir = undef;
1733
1734      $ssh2->disconnect();
1735
1736      my $ok = 1;
1737      my $mismatch;
1738
1739      my $seen = [];
1740      foreach my $name (keys(%$res)) {
1741        push(@$seen, $name);
1742
1743        unless (defined($expected->{$name})) {
1744          $mismatch = $name;
1745          $ok = 0;
1746          last;
1747        }
1748      }
1749
1750      unless ($ok) {
1751        die("Unexpected name '$mismatch' appeared in READDIR data")
1752      }
1753
1754      # Now remove from $expected all of the paths we saw; if there are
1755      # any entries remaining in $expected, something went wrong.
1756      foreach my $name (@$seen) {
1757        delete($expected->{$name});
1758      }
1759
1760      my $remaining = scalar(keys(%$expected));
1761      $self->assert(0 == $remaining,
1762        test_msg("Expected 0, got $remaining"));
1763    };
1764
1765    if ($@) {
1766      $ex = $@;
1767    }
1768
1769    $wfh->print("done\n");
1770    $wfh->flush();
1771
1772  } else {
1773    eval { server_wait($config_file, $rfh) };
1774    if ($@) {
1775      warn($@);
1776      exit 1;
1777    }
1778
1779    exit 0;
1780  }
1781
1782  # Stop server
1783  server_stop($pid_file);
1784
1785  $self->assert_child_ok($pid);
1786
1787  if ($ex) {
1788    test_append_logfile($log_file, $ex);
1789    unlink($log_file);
1790
1791    die($ex);
1792  }
1793
1794  unlink($log_file);
1795}
1796
1797sub sftp_rewrite_mkdir {
1798  my $self = shift;
1799  my $tmpdir = $self->{tmpdir};
1800
1801  my $config_file = "$tmpdir/sftp.conf";
1802  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
1803  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
1804
1805  my $log_file = test_get_logfile();
1806
1807  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
1808  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
1809
1810  my $user = 'proftpd';
1811  my $passwd = 'test';
1812  my $group = 'ftpd';
1813  my $home_dir = File::Spec->rel2abs($tmpdir);
1814  my $uid = 500;
1815  my $gid = 500;
1816
1817  my $test_dir = File::Spec->rel2abs("$tmpdir/test_dir");
1818
1819  # Make sure that, if we're running as root, that the home directory has
1820  # permissions/privs set for the account we create
1821  if ($< == 0) {
1822    unless (chmod(0755, $home_dir)) {
1823      die("Can't set perms on $home_dir to 0755: $!");
1824    }
1825
1826    unless (chown($uid, $gid, $home_dir)) {
1827      die("Can't set owner of $home_dir to $uid/$gid: $!");
1828    }
1829  }
1830
1831  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
1832    '/bin/bash');
1833  auth_group_write($auth_group_file, $group, $gid, $user);
1834
1835  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
1836  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
1837
1838  my $config = {
1839    PidFile => $pid_file,
1840    ScoreboardFile => $scoreboard_file,
1841    SystemLog => $log_file,
1842    TraceLog => $log_file,
1843    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
1844
1845    AuthUserFile => $auth_user_file,
1846    AuthGroupFile => $auth_group_file,
1847
1848    IfModules => {
1849      'mod_delay.c' => {
1850        DelayEngine => 'off',
1851      },
1852
1853      'mod_rewrite.c' => [
1854        'RewriteEngine on',
1855        "RewriteLog $log_file",
1856
1857        'RewriteMap replace int:replaceall',
1858        'RewriteCondition %m MKDIR',
1859        'RewriteRule ^(.*) "${replace:!$1! !_}"',
1860      ],
1861
1862      'mod_sftp.c' => [
1863        "SFTPEngine on",
1864        "SFTPLog $log_file",
1865        "SFTPHostKey $rsa_host_key",
1866        "SFTPHostKey $dsa_host_key",
1867      ],
1868    },
1869  };
1870
1871  my ($port, $config_user, $config_group) = config_write($config_file, $config);
1872
1873  # Open pipes, for use between the parent and child processes.  Specifically,
1874  # the child will indicate when it's done with its test by writing a message
1875  # to the parent.
1876  my ($rfh, $wfh);
1877  unless (pipe($rfh, $wfh)) {
1878    die("Can't open pipe: $!");
1879  }
1880
1881  require Net::SSH2;
1882
1883  my $ex;
1884
1885  # Fork child
1886  $self->handle_sigchld();
1887  defined(my $pid = fork()) or die("Can't fork: $!");
1888  if ($pid) {
1889    eval {
1890      my $ssh2 = Net::SSH2->new();
1891
1892      sleep(1);
1893
1894      unless ($ssh2->connect('127.0.0.1', $port)) {
1895        my ($err_code, $err_name, $err_str) = $ssh2->error();
1896        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
1897      }
1898
1899      unless ($ssh2->auth_password($user, $passwd)) {
1900        my ($err_code, $err_name, $err_str) = $ssh2->error();
1901        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
1902      }
1903
1904      my $sftp = $ssh2->sftp();
1905      unless ($sftp) {
1906        my ($err_code, $err_name, $err_str) = $ssh2->error();
1907        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
1908      }
1909
1910      my $res = $sftp->mkdir('test dir');
1911      unless ($res) {
1912        my ($err_code, $err_name) = $sftp->error();
1913        die("FXP_MKDIR failed: [$err_name] ($err_code)");
1914      }
1915
1916      $ssh2->disconnect();
1917
1918      unless (-d $test_dir) {
1919        die("$test_dir directory does not exist as expected");
1920      }
1921    };
1922
1923    if ($@) {
1924      $ex = $@;
1925    }
1926
1927    $wfh->print("done\n");
1928    $wfh->flush();
1929
1930  } else {
1931    eval { server_wait($config_file, $rfh) };
1932    if ($@) {
1933      warn($@);
1934      exit 1;
1935    }
1936
1937    exit 0;
1938  }
1939
1940  # Stop server
1941  server_stop($pid_file);
1942
1943  $self->assert_child_ok($pid);
1944
1945  if ($ex) {
1946    test_append_logfile($log_file, $ex);
1947    unlink($log_file);
1948
1949    die($ex);
1950  }
1951
1952  unlink($log_file);
1953}
1954
1955sub sftp_rewrite_rmdir {
1956  my $self = shift;
1957  my $tmpdir = $self->{tmpdir};
1958
1959  my $config_file = "$tmpdir/sftp.conf";
1960  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
1961  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
1962
1963  my $log_file = test_get_logfile();
1964
1965  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
1966  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
1967
1968  my $user = 'proftpd';
1969  my $passwd = 'test';
1970  my $group = 'ftpd';
1971  my $home_dir = File::Spec->rel2abs($tmpdir);
1972  my $uid = 500;
1973  my $gid = 500;
1974
1975  my $test_dir = File::Spec->rel2abs("$tmpdir/test_dir");
1976  mkpath($test_dir);
1977
1978  # Make sure that, if we're running as root, that the home directory has
1979  # permissions/privs set for the account we create
1980  if ($< == 0) {
1981    unless (chmod(0755, $home_dir)) {
1982      die("Can't set perms on $home_dir to 0755: $!");
1983    }
1984
1985    unless (chown($uid, $gid, $home_dir)) {
1986      die("Can't set owner of $home_dir to $uid/$gid: $!");
1987    }
1988  }
1989
1990  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
1991    '/bin/bash');
1992  auth_group_write($auth_group_file, $group, $gid, $user);
1993
1994  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
1995  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
1996
1997  my $config = {
1998    PidFile => $pid_file,
1999    ScoreboardFile => $scoreboard_file,
2000    SystemLog => $log_file,
2001    TraceLog => $log_file,
2002    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
2003
2004    AuthUserFile => $auth_user_file,
2005    AuthGroupFile => $auth_group_file,
2006
2007    IfModules => {
2008      'mod_delay.c' => {
2009        DelayEngine => 'off',
2010      },
2011
2012      'mod_rewrite.c' => [
2013        'RewriteEngine on',
2014        "RewriteLog $log_file",
2015
2016        'RewriteMap replace int:replaceall',
2017        'RewriteCondition %m RMDIR',
2018        'RewriteRule ^(.*) "${replace:!$1! !_}"',
2019      ],
2020
2021      'mod_sftp.c' => [
2022        "SFTPEngine on",
2023        "SFTPLog $log_file",
2024        "SFTPHostKey $rsa_host_key",
2025        "SFTPHostKey $dsa_host_key",
2026      ],
2027    },
2028  };
2029
2030  my ($port, $config_user, $config_group) = config_write($config_file, $config);
2031
2032  # Open pipes, for use between the parent and child processes.  Specifically,
2033  # the child will indicate when it's done with its test by writing a message
2034  # to the parent.
2035  my ($rfh, $wfh);
2036  unless (pipe($rfh, $wfh)) {
2037    die("Can't open pipe: $!");
2038  }
2039
2040  require Net::SSH2;
2041
2042  my $ex;
2043
2044  # Fork child
2045  $self->handle_sigchld();
2046  defined(my $pid = fork()) or die("Can't fork: $!");
2047  if ($pid) {
2048    eval {
2049      my $ssh2 = Net::SSH2->new();
2050
2051      sleep(1);
2052
2053      unless ($ssh2->connect('127.0.0.1', $port)) {
2054        my ($err_code, $err_name, $err_str) = $ssh2->error();
2055        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
2056      }
2057
2058      unless ($ssh2->auth_password($user, $passwd)) {
2059        my ($err_code, $err_name, $err_str) = $ssh2->error();
2060        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
2061      }
2062
2063      my $sftp = $ssh2->sftp();
2064      unless ($sftp) {
2065        my ($err_code, $err_name, $err_str) = $ssh2->error();
2066        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
2067      }
2068
2069      my $res = $sftp->rmdir('test dir');
2070      unless ($res) {
2071        my ($err_code, $err_name) = $sftp->error();
2072        die("FXP_RMDIR failed: [$err_name] ($err_code)");
2073      }
2074
2075      $ssh2->disconnect();
2076
2077      if (-d $test_dir) {
2078        die("$test_dir directory exists unexpectedly");
2079      }
2080    };
2081
2082    if ($@) {
2083      $ex = $@;
2084    }
2085
2086    $wfh->print("done\n");
2087    $wfh->flush();
2088
2089  } else {
2090    eval { server_wait($config_file, $rfh) };
2091    if ($@) {
2092      warn($@);
2093      exit 1;
2094    }
2095
2096    exit 0;
2097  }
2098
2099  # Stop server
2100  server_stop($pid_file);
2101
2102  $self->assert_child_ok($pid);
2103
2104  if ($ex) {
2105    test_append_logfile($log_file, $ex);
2106    unlink($log_file);
2107
2108    die($ex);
2109  }
2110
2111  unlink($log_file);
2112}
2113
2114sub sftp_rewrite_remove {
2115  my $self = shift;
2116  my $tmpdir = $self->{tmpdir};
2117
2118  my $config_file = "$tmpdir/sftp.conf";
2119  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
2120  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
2121
2122  my $log_file = test_get_logfile();
2123
2124  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
2125  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
2126
2127  my $user = 'proftpd';
2128  my $passwd = 'test';
2129  my $group = 'ftpd';
2130  my $home_dir = File::Spec->rel2abs($tmpdir);
2131  my $uid = 500;
2132  my $gid = 500;
2133
2134  my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt");
2135  if (open(my $fh, "> $test_file")) {
2136    print $fh "ABCD" x 8192;
2137
2138    unless (close($fh)) {
2139      die("Can't write $test_file: $!");
2140    }
2141
2142  } else {
2143    die("Can't open $test_file: $!");
2144  }
2145
2146  # Make sure that, if we're running as root, that the home directory has
2147  # permissions/privs set for the account we create
2148  if ($< == 0) {
2149    unless (chmod(0755, $home_dir)) {
2150      die("Can't set perms on $home_dir to 0755: $!");
2151    }
2152
2153    unless (chown($uid, $gid, $home_dir)) {
2154      die("Can't set owner of $home_dir to $uid/$gid: $!");
2155    }
2156  }
2157
2158  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
2159    '/bin/bash');
2160  auth_group_write($auth_group_file, $group, $gid, $user);
2161
2162  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
2163  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
2164
2165  my $config = {
2166    PidFile => $pid_file,
2167    ScoreboardFile => $scoreboard_file,
2168    SystemLog => $log_file,
2169    TraceLog => $log_file,
2170    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
2171
2172    AuthUserFile => $auth_user_file,
2173    AuthGroupFile => $auth_group_file,
2174
2175    IfModules => {
2176      'mod_delay.c' => {
2177        DelayEngine => 'off',
2178      },
2179
2180      'mod_rewrite.c' => [
2181        'RewriteEngine on',
2182        "RewriteLog $log_file",
2183
2184        'RewriteMap replace int:replaceall',
2185        'RewriteCondition %m REMOVE',
2186        'RewriteRule ^(.*) "${replace:!$1! !_}"',
2187      ],
2188
2189      'mod_sftp.c' => [
2190        "SFTPEngine on",
2191        "SFTPLog $log_file",
2192        "SFTPHostKey $rsa_host_key",
2193        "SFTPHostKey $dsa_host_key",
2194      ],
2195    },
2196  };
2197
2198  my ($port, $config_user, $config_group) = config_write($config_file, $config);
2199
2200  # Open pipes, for use between the parent and child processes.  Specifically,
2201  # the child will indicate when it's done with its test by writing a message
2202  # to the parent.
2203  my ($rfh, $wfh);
2204  unless (pipe($rfh, $wfh)) {
2205    die("Can't open pipe: $!");
2206  }
2207
2208  require Net::SSH2;
2209
2210  my $ex;
2211
2212  # Fork child
2213  $self->handle_sigchld();
2214  defined(my $pid = fork()) or die("Can't fork: $!");
2215  if ($pid) {
2216    eval {
2217      my $ssh2 = Net::SSH2->new();
2218
2219      sleep(1);
2220
2221      unless ($ssh2->connect('127.0.0.1', $port)) {
2222        my ($err_code, $err_name, $err_str) = $ssh2->error();
2223        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
2224      }
2225
2226      unless ($ssh2->auth_password($user, $passwd)) {
2227        my ($err_code, $err_name, $err_str) = $ssh2->error();
2228        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
2229      }
2230
2231      my $sftp = $ssh2->sftp();
2232      unless ($sftp) {
2233        my ($err_code, $err_name, $err_str) = $ssh2->error();
2234        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
2235      }
2236
2237      my $res = $sftp->unlink('test file.txt');
2238      unless ($res) {
2239        my ($err_code, $err_name) = $sftp->error();
2240        die("FXP_REMOVE failed: [$err_name] ($err_code)");
2241      }
2242
2243      $ssh2->disconnect();
2244
2245      if (-f $test_file) {
2246        die("$test_file file exists unexpectedly");
2247      }
2248    };
2249
2250    if ($@) {
2251      $ex = $@;
2252    }
2253
2254    $wfh->print("done\n");
2255    $wfh->flush();
2256
2257  } else {
2258    eval { server_wait($config_file, $rfh) };
2259    if ($@) {
2260      warn($@);
2261      exit 1;
2262    }
2263
2264    exit 0;
2265  }
2266
2267  # Stop server
2268  server_stop($pid_file);
2269
2270  $self->assert_child_ok($pid);
2271
2272  if ($ex) {
2273    test_append_logfile($log_file, $ex);
2274    unlink($log_file);
2275
2276    die($ex);
2277  }
2278
2279  unlink($log_file);
2280}
2281
2282sub sftp_rewrite_rename {
2283  my $self = shift;
2284  my $tmpdir = $self->{tmpdir};
2285
2286  my $config_file = "$tmpdir/sftp.conf";
2287  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
2288  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
2289
2290  my $log_file = test_get_logfile();
2291
2292  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
2293  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
2294
2295  my $user = 'proftpd';
2296  my $passwd = 'test';
2297  my $group = 'ftpd';
2298  my $home_dir = File::Spec->rel2abs($tmpdir);
2299  my $uid = 500;
2300  my $gid = 500;
2301
2302  my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt");
2303  if (open(my $fh, "> $test_file")) {
2304    print $fh "ABCD" x 8192;
2305
2306    unless (close($fh)) {
2307      die("Can't write $test_file: $!");
2308    }
2309
2310  } else {
2311    die("Can't open $test_file: $!");
2312  }
2313
2314  my $test_file2 = File::Spec->rel2abs("$tmpdir/test_file2.txt");
2315
2316  # Make sure that, if we're running as root, that the home directory has
2317  # permissions/privs set for the account we create
2318  if ($< == 0) {
2319    unless (chmod(0755, $home_dir)) {
2320      die("Can't set perms on $home_dir to 0755: $!");
2321    }
2322
2323    unless (chown($uid, $gid, $home_dir)) {
2324      die("Can't set owner of $home_dir to $uid/$gid: $!");
2325    }
2326  }
2327
2328  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
2329    '/bin/bash');
2330  auth_group_write($auth_group_file, $group, $gid, $user);
2331
2332  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
2333  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
2334
2335  my $config = {
2336    PidFile => $pid_file,
2337    ScoreboardFile => $scoreboard_file,
2338    SystemLog => $log_file,
2339    TraceLog => $log_file,
2340    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
2341
2342    AuthUserFile => $auth_user_file,
2343    AuthGroupFile => $auth_group_file,
2344
2345    IfModules => {
2346      'mod_delay.c' => {
2347        DelayEngine => 'off',
2348      },
2349
2350      'mod_rewrite.c' => [
2351        'RewriteEngine on',
2352        "RewriteLog $log_file",
2353
2354        'RewriteMap replace int:replaceall',
2355        'RewriteCondition %m ^(RNFR|RNTO)$',
2356        'RewriteRule ^(.*)$ "${replace:!$1! !_}"',
2357      ],
2358
2359      'mod_sftp.c' => [
2360        "SFTPEngine on",
2361        "SFTPLog $log_file",
2362        "SFTPHostKey $rsa_host_key",
2363        "SFTPHostKey $dsa_host_key",
2364      ],
2365    },
2366  };
2367
2368  my ($port, $config_user, $config_group) = config_write($config_file, $config);
2369
2370  # Open pipes, for use between the parent and child processes.  Specifically,
2371  # the child will indicate when it's done with its test by writing a message
2372  # to the parent.
2373  my ($rfh, $wfh);
2374  unless (pipe($rfh, $wfh)) {
2375    die("Can't open pipe: $!");
2376  }
2377
2378  require Net::SSH2;
2379
2380  my $ex;
2381
2382  # Fork child
2383  $self->handle_sigchld();
2384  defined(my $pid = fork()) or die("Can't fork: $!");
2385  if ($pid) {
2386    eval {
2387      my $ssh2 = Net::SSH2->new();
2388
2389      sleep(1);
2390
2391      unless ($ssh2->connect('127.0.0.1', $port)) {
2392        my ($err_code, $err_name, $err_str) = $ssh2->error();
2393        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
2394      }
2395
2396      unless ($ssh2->auth_password($user, $passwd)) {
2397        my ($err_code, $err_name, $err_str) = $ssh2->error();
2398        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
2399      }
2400
2401      my $sftp = $ssh2->sftp();
2402      unless ($sftp) {
2403        my ($err_code, $err_name, $err_str) = $ssh2->error();
2404        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
2405      }
2406
2407      my $res = $sftp->rename('test file.txt', 'test file2.txt');
2408      unless ($res) {
2409        my ($err_code, $err_name) = $sftp->error();
2410        die("FXP_RENAME failed: [$err_name] ($err_code)");
2411      }
2412
2413      $ssh2->disconnect();
2414
2415      if (-f $test_file) {
2416        die("$test_file file exists unexpectedly");
2417      }
2418
2419      unless (-f $test_file2) {
2420        die("$test_file2 file does not exist as expected");
2421      }
2422    };
2423
2424    if ($@) {
2425      $ex = $@;
2426    }
2427
2428    $wfh->print("done\n");
2429    $wfh->flush();
2430
2431  } else {
2432    eval { server_wait($config_file, $rfh) };
2433    if ($@) {
2434      warn($@);
2435      exit 1;
2436    }
2437
2438    exit 0;
2439  }
2440
2441  # Stop server
2442  server_stop($pid_file);
2443
2444  $self->assert_child_ok($pid);
2445
2446  if ($ex) {
2447    test_append_logfile($log_file, $ex);
2448    unlink($log_file);
2449
2450    die($ex);
2451  }
2452
2453  unlink($log_file);
2454}
2455
2456sub sftp_rewrite_rename_file_var_w_bug3643 {
2457  my $self = shift;
2458  my $tmpdir = $self->{tmpdir};
2459
2460  my $config_file = "$tmpdir/sftp.conf";
2461  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
2462  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
2463
2464  my $log_file = test_get_logfile();
2465
2466  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
2467  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
2468
2469  my $user = 'proftpd';
2470  my $passwd = 'test';
2471  my $group = 'ftpd';
2472  my $home_dir = File::Spec->rel2abs($tmpdir);
2473  my $uid = 500;
2474  my $gid = 500;
2475
2476  my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt");
2477  if (open(my $fh, "> $test_file")) {
2478    print $fh "ABCD" x 8192;
2479
2480    unless (close($fh)) {
2481      die("Can't write $test_file: $!");
2482    }
2483
2484  } else {
2485    die("Can't open $test_file: $!");
2486  }
2487
2488  my $test_file2 = File::Spec->rel2abs("$tmpdir/test_file2.txt");
2489
2490  # Make sure that, if we're running as root, that the home directory has
2491  # permissions/privs set for the account we create
2492  if ($< == 0) {
2493    unless (chmod(0755, $home_dir)) {
2494      die("Can't set perms on $home_dir to 0755: $!");
2495    }
2496
2497    unless (chown($uid, $gid, $home_dir)) {
2498      die("Can't set owner of $home_dir to $uid/$gid: $!");
2499    }
2500  }
2501
2502  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
2503    '/bin/bash');
2504  auth_group_write($auth_group_file, $group, $gid, $user);
2505
2506  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
2507  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
2508
2509  my $config = {
2510    PidFile => $pid_file,
2511    ScoreboardFile => $scoreboard_file,
2512    SystemLog => $log_file,
2513    TraceLog => $log_file,
2514    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
2515
2516    AuthUserFile => $auth_user_file,
2517    AuthGroupFile => $auth_group_file,
2518
2519    IfModules => {
2520      'mod_delay.c' => {
2521        DelayEngine => 'off',
2522      },
2523
2524      'mod_rewrite.c' => [
2525        'RewriteEngine on',
2526        "RewriteLog $log_file",
2527
2528        'RewriteMap lowercase int:tolower',
2529        'RewriteCondition %m ^RNTO$',
2530        'RewriteCondition %w -f',
2531        'RewriteRule ^(.*) ${lowercase:$0}',
2532      ],
2533
2534      'mod_sftp.c' => [
2535        "SFTPEngine on",
2536        "SFTPLog $log_file",
2537        "SFTPHostKey $rsa_host_key",
2538        "SFTPHostKey $dsa_host_key",
2539      ],
2540    },
2541  };
2542
2543  my ($port, $config_user, $config_group) = config_write($config_file, $config);
2544
2545  # Open pipes, for use between the parent and child processes.  Specifically,
2546  # the child will indicate when it's done with its test by writing a message
2547  # to the parent.
2548  my ($rfh, $wfh);
2549  unless (pipe($rfh, $wfh)) {
2550    die("Can't open pipe: $!");
2551  }
2552
2553  require Net::SSH2;
2554
2555  my $ex;
2556
2557  # Fork child
2558  $self->handle_sigchld();
2559  defined(my $pid = fork()) or die("Can't fork: $!");
2560  if ($pid) {
2561    eval {
2562      my $ssh2 = Net::SSH2->new();
2563
2564      sleep(1);
2565
2566      unless ($ssh2->connect('127.0.0.1', $port)) {
2567        my ($err_code, $err_name, $err_str) = $ssh2->error();
2568        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
2569      }
2570
2571      unless ($ssh2->auth_password($user, $passwd)) {
2572        my ($err_code, $err_name, $err_str) = $ssh2->error();
2573        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
2574      }
2575
2576      my $sftp = $ssh2->sftp();
2577      unless ($sftp) {
2578        my ($err_code, $err_name, $err_str) = $ssh2->error();
2579        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
2580      }
2581
2582      my $res = $sftp->rename('test_file.txt', 'TeST_FiLe2.TxT');
2583      unless ($res) {
2584        my ($err_code, $err_name) = $sftp->error();
2585        die("FXP_RENAME failed: [$err_name] ($err_code)");
2586      }
2587
2588      $ssh2->disconnect();
2589
2590      if (-f $test_file) {
2591        die("$test_file file exists unexpectedly");
2592      }
2593
2594      unless (-f $test_file2) {
2595        die("$test_file2 file does not exist as expected");
2596      }
2597    };
2598
2599    if ($@) {
2600      $ex = $@;
2601    }
2602
2603    $wfh->print("done\n");
2604    $wfh->flush();
2605
2606  } else {
2607    eval { server_wait($config_file, $rfh) };
2608    if ($@) {
2609      warn($@);
2610      exit 1;
2611    }
2612
2613    exit 0;
2614  }
2615
2616  # Stop server
2617  server_stop($pid_file);
2618
2619  $self->assert_child_ok($pid);
2620
2621  if ($ex) {
2622    test_append_logfile($log_file, $ex);
2623    unlink($log_file);
2624
2625    die($ex);
2626  }
2627
2628  unlink($log_file);
2629}
2630
2631sub sftp_rewrite_rename_dir_var_w_bug3643 {
2632  my $self = shift;
2633  my $tmpdir = $self->{tmpdir};
2634
2635  my $config_file = "$tmpdir/sftp.conf";
2636  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
2637  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
2638
2639  my $log_file = test_get_logfile();
2640
2641  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
2642  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
2643
2644  my $user = 'proftpd';
2645  my $passwd = 'test';
2646  my $group = 'ftpd';
2647  my $home_dir = File::Spec->rel2abs($tmpdir);
2648  my $uid = 500;
2649  my $gid = 500;
2650
2651  my $src_dir = File::Spec->rel2abs("$tmpdir/foo.d");
2652  mkpath($src_dir);
2653
2654  my $dst_dir = File::Spec->rel2abs("$tmpdir/bar.d");
2655
2656  # Make sure that, if we're running as root, that the home directory has
2657  # permissions/privs set for the account we create
2658  if ($< == 0) {
2659    unless (chmod(0755, $home_dir)) {
2660      die("Can't set perms on $home_dir to 0755: $!");
2661    }
2662
2663    unless (chown($uid, $gid, $home_dir)) {
2664      die("Can't set owner of $home_dir to $uid/$gid: $!");
2665    }
2666  }
2667
2668  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
2669    '/bin/bash');
2670  auth_group_write($auth_group_file, $group, $gid, $user);
2671
2672  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
2673  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
2674
2675  my $config = {
2676    PidFile => $pid_file,
2677    ScoreboardFile => $scoreboard_file,
2678    SystemLog => $log_file,
2679    TraceLog => $log_file,
2680    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
2681
2682    AuthUserFile => $auth_user_file,
2683    AuthGroupFile => $auth_group_file,
2684
2685    IfModules => {
2686      'mod_delay.c' => {
2687        DelayEngine => 'off',
2688      },
2689
2690      'mod_rewrite.c' => [
2691        'RewriteEngine on',
2692        "RewriteLog $log_file",
2693
2694        'RewriteMap lowercase int:tolower',
2695        'RewriteCondition %m ^RNTO$',
2696        'RewriteCondition %w -d',
2697        'RewriteRule ^(.*) ${lowercase:$0}',
2698      ],
2699
2700      'mod_sftp.c' => [
2701        "SFTPEngine on",
2702        "SFTPLog $log_file",
2703        "SFTPHostKey $rsa_host_key",
2704        "SFTPHostKey $dsa_host_key",
2705      ],
2706    },
2707  };
2708
2709  my ($port, $config_user, $config_group) = config_write($config_file, $config);
2710
2711  # Open pipes, for use between the parent and child processes.  Specifically,
2712  # the child will indicate when it's done with its test by writing a message
2713  # to the parent.
2714  my ($rfh, $wfh);
2715  unless (pipe($rfh, $wfh)) {
2716    die("Can't open pipe: $!");
2717  }
2718
2719  require Net::SSH2;
2720
2721  my $ex;
2722
2723  # Fork child
2724  $self->handle_sigchld();
2725  defined(my $pid = fork()) or die("Can't fork: $!");
2726  if ($pid) {
2727    eval {
2728      my $ssh2 = Net::SSH2->new();
2729
2730      sleep(1);
2731
2732      unless ($ssh2->connect('127.0.0.1', $port)) {
2733        my ($err_code, $err_name, $err_str) = $ssh2->error();
2734        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
2735      }
2736
2737      unless ($ssh2->auth_password($user, $passwd)) {
2738        my ($err_code, $err_name, $err_str) = $ssh2->error();
2739        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
2740      }
2741
2742      my $sftp = $ssh2->sftp();
2743      unless ($sftp) {
2744        my ($err_code, $err_name, $err_str) = $ssh2->error();
2745        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
2746      }
2747
2748      my $res = $sftp->rename('foo.d', 'BaR.D');
2749      unless ($res) {
2750        my ($err_code, $err_name) = $sftp->error();
2751        die("FXP_RENAME failed: [$err_name] ($err_code)");
2752      }
2753
2754      $ssh2->disconnect();
2755
2756      if (-d $src_dir) {
2757        die("$src_dir directory exists unexpectedly");
2758      }
2759
2760      unless (-d $dst_dir) {
2761        die("$dst_dir directory does not exist as expected");
2762      }
2763    };
2764
2765    if ($@) {
2766      $ex = $@;
2767    }
2768
2769    $wfh->print("done\n");
2770    $wfh->flush();
2771
2772  } else {
2773    eval { server_wait($config_file, $rfh) };
2774    if ($@) {
2775      warn($@);
2776      exit 1;
2777    }
2778
2779    exit 0;
2780  }
2781
2782  # Stop server
2783  server_stop($pid_file);
2784
2785  $self->assert_child_ok($pid);
2786
2787  if ($ex) {
2788    test_append_logfile($log_file, $ex);
2789    unlink($log_file);
2790
2791    die($ex);
2792  }
2793
2794  unlink($log_file);
2795}
2796
2797sub sftp_rewrite_symlink {
2798  my $self = shift;
2799  my $tmpdir = $self->{tmpdir};
2800
2801  my $config_file = "$tmpdir/sftp.conf";
2802  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
2803  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
2804
2805  my $log_file = test_get_logfile();
2806
2807  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
2808  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
2809
2810  my $user = 'proftpd';
2811  my $passwd = 'test';
2812  my $group = 'ftpd';
2813  my $home_dir = File::Spec->rel2abs($tmpdir);
2814  my $uid = 500;
2815  my $gid = 500;
2816
2817  my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt");
2818  if (open(my $fh, "> $test_file")) {
2819    print $fh "ABCD" x 8192;
2820
2821    unless (close($fh)) {
2822      die("Can't write $test_file: $!");
2823    }
2824
2825  } else {
2826    die("Can't open $test_file: $!");
2827  }
2828
2829  my $test_symlink = File::Spec->rel2abs("$tmpdir/test_link");
2830
2831  # Make sure that, if we're running as root, that the home directory has
2832  # permissions/privs set for the account we create
2833  if ($< == 0) {
2834    unless (chmod(0755, $home_dir)) {
2835      die("Can't set perms on $home_dir to 0755: $!");
2836    }
2837
2838    unless (chown($uid, $gid, $home_dir)) {
2839      die("Can't set owner of $home_dir to $uid/$gid: $!");
2840    }
2841  }
2842
2843  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
2844    '/bin/bash');
2845  auth_group_write($auth_group_file, $group, $gid, $user);
2846
2847  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
2848  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
2849
2850  my $config = {
2851    PidFile => $pid_file,
2852    ScoreboardFile => $scoreboard_file,
2853    SystemLog => $log_file,
2854    TraceLog => $log_file,
2855    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
2856
2857    AuthUserFile => $auth_user_file,
2858    AuthGroupFile => $auth_group_file,
2859
2860    IfModules => {
2861      'mod_delay.c' => {
2862        DelayEngine => 'off',
2863      },
2864
2865      'mod_rewrite.c' => [
2866        'RewriteEngine on',
2867        "RewriteLog $log_file",
2868
2869        'RewriteMap replace int:replaceall',
2870        'RewriteCondition %m SYMLINK',
2871        'RewriteRule ^(.*)$ "${replace:!$1! !_}"',
2872      ],
2873
2874      'mod_sftp.c' => [
2875        "SFTPEngine on",
2876        "SFTPLog $log_file",
2877        "SFTPHostKey $rsa_host_key",
2878        "SFTPHostKey $dsa_host_key",
2879      ],
2880    },
2881  };
2882
2883  my ($port, $config_user, $config_group) = config_write($config_file, $config);
2884
2885  # Open pipes, for use between the parent and child processes.  Specifically,
2886  # the child will indicate when it's done with its test by writing a message
2887  # to the parent.
2888  my ($rfh, $wfh);
2889  unless (pipe($rfh, $wfh)) {
2890    die("Can't open pipe: $!");
2891  }
2892
2893  require Net::SSH2;
2894
2895  my $ex;
2896
2897  # Fork child
2898  $self->handle_sigchld();
2899  defined(my $pid = fork()) or die("Can't fork: $!");
2900  if ($pid) {
2901    eval {
2902      my $ssh2 = Net::SSH2->new();
2903
2904      sleep(1);
2905
2906      unless ($ssh2->connect('127.0.0.1', $port)) {
2907        my ($err_code, $err_name, $err_str) = $ssh2->error();
2908        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
2909      }
2910
2911      unless ($ssh2->auth_password($user, $passwd)) {
2912        my ($err_code, $err_name, $err_str) = $ssh2->error();
2913        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
2914      }
2915
2916      my $sftp = $ssh2->sftp();
2917      unless ($sftp) {
2918        my ($err_code, $err_name, $err_str) = $ssh2->error();
2919        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
2920      }
2921
2922      my $res = $sftp->symlink('test file.txt', 'test link');
2923      unless ($res) {
2924        my ($err_code, $err_name) = $sftp->error();
2925        die("FXP_SYMLINK failed: [$err_name] ($err_code)");
2926      }
2927
2928      # To close the SFTP channel, we have to explicitly destroy the object
2929      $sftp = undef;
2930
2931      $ssh2->disconnect();
2932
2933      unless (-l $test_symlink) {
2934        die("$test_symlink symlink does not exist as expected");
2935      }
2936    };
2937
2938    if ($@) {
2939      $ex = $@;
2940    }
2941
2942    $wfh->print("done\n");
2943    $wfh->flush();
2944
2945  } else {
2946    eval { server_wait($config_file, $rfh) };
2947    if ($@) {
2948      warn($@);
2949      exit 1;
2950    }
2951
2952    exit 0;
2953  }
2954
2955  # Stop server
2956  server_stop($pid_file);
2957
2958  $self->assert_child_ok($pid);
2959
2960  if ($ex) {
2961    test_append_logfile($log_file, $ex);
2962    unlink($log_file);
2963
2964    die($ex);
2965  }
2966
2967  unlink($log_file);
2968}
2969
2970sub sftp_rewrite_readlink {
2971  my $self = shift;
2972  my $tmpdir = $self->{tmpdir};
2973
2974  my $config_file = "$tmpdir/sftp.conf";
2975  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
2976  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
2977
2978  my $log_file = test_get_logfile();
2979
2980  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
2981  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
2982
2983  my $user = 'proftpd';
2984  my $passwd = 'test';
2985  my $group = 'ftpd';
2986  my $home_dir = File::Spec->rel2abs($tmpdir);
2987  my $uid = 500;
2988  my $gid = 500;
2989
2990  my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt");
2991  if (open(my $fh, "> $test_file")) {
2992    print $fh "ABCD" x 8192;
2993
2994    unless (close($fh)) {
2995      die("Can't write $test_file: $!");
2996    }
2997
2998  } else {
2999    die("Can't open $test_file: $!");
3000  }
3001
3002  my $test_symlink = File::Spec->rel2abs("$tmpdir/test_link");
3003  unless (symlink($test_file, $test_symlink)) {
3004    die("Can't symlink $test_symlink to $test_file: $!");
3005  }
3006
3007  # Make sure that, if we're running as root, that the home directory has
3008  # permissions/privs set for the account we create
3009  if ($< == 0) {
3010    unless (chmod(0755, $home_dir)) {
3011      die("Can't set perms on $home_dir to 0755: $!");
3012    }
3013
3014    unless (chown($uid, $gid, $home_dir)) {
3015      die("Can't set owner of $home_dir to $uid/$gid: $!");
3016    }
3017  }
3018
3019  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
3020    '/bin/bash');
3021  auth_group_write($auth_group_file, $group, $gid, $user);
3022
3023  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
3024  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
3025
3026  my $config = {
3027    PidFile => $pid_file,
3028    ScoreboardFile => $scoreboard_file,
3029    SystemLog => $log_file,
3030    TraceLog => $log_file,
3031    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
3032
3033    AuthUserFile => $auth_user_file,
3034    AuthGroupFile => $auth_group_file,
3035
3036    IfModules => {
3037      'mod_delay.c' => {
3038        DelayEngine => 'off',
3039      },
3040
3041      'mod_rewrite.c' => [
3042        'RewriteEngine on',
3043        "RewriteLog $log_file",
3044
3045        'RewriteMap replace int:replaceall',
3046        'RewriteCondition %m READLINK',
3047        'RewriteRule ^(.*)$ "${replace:!$1! !_}"',
3048      ],
3049
3050      'mod_sftp.c' => [
3051        "SFTPEngine on",
3052        "SFTPLog $log_file",
3053        "SFTPHostKey $rsa_host_key",
3054        "SFTPHostKey $dsa_host_key",
3055      ],
3056    },
3057  };
3058
3059  my ($port, $config_user, $config_group) = config_write($config_file, $config);
3060
3061  # Open pipes, for use between the parent and child processes.  Specifically,
3062  # the child will indicate when it's done with its test by writing a message
3063  # to the parent.
3064  my ($rfh, $wfh);
3065  unless (pipe($rfh, $wfh)) {
3066    die("Can't open pipe: $!");
3067  }
3068
3069  require Net::SSH2;
3070
3071  my $ex;
3072
3073  # Fork child
3074  $self->handle_sigchld();
3075  defined(my $pid = fork()) or die("Can't fork: $!");
3076  if ($pid) {
3077    eval {
3078      my $ssh2 = Net::SSH2->new();
3079
3080      sleep(1);
3081
3082      unless ($ssh2->connect('127.0.0.1', $port)) {
3083        my ($err_code, $err_name, $err_str) = $ssh2->error();
3084        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
3085      }
3086
3087      unless ($ssh2->auth_password($user, $passwd)) {
3088        my ($err_code, $err_name, $err_str) = $ssh2->error();
3089        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
3090      }
3091
3092      my $sftp = $ssh2->sftp();
3093      unless ($sftp) {
3094        my ($err_code, $err_name, $err_str) = $ssh2->error();
3095        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
3096      }
3097
3098      my $path = $sftp->readlink('test link');
3099      unless ($path) {
3100        my ($err_code, $err_name) = $sftp->error();
3101        die("FXP_READLINK failed: [$err_name] ($err_code)");
3102      }
3103
3104      $ssh2->disconnect();
3105
3106      $self->assert($test_file eq $path,
3107        test_msg("Expected '$test_file', got '$path'"));
3108    };
3109
3110    if ($@) {
3111      $ex = $@;
3112    }
3113
3114    $wfh->print("done\n");
3115    $wfh->flush();
3116
3117  } else {
3118    eval { server_wait($config_file, $rfh) };
3119    if ($@) {
3120      warn($@);
3121      exit 1;
3122    }
3123
3124    exit 0;
3125  }
3126
3127  # Stop server
3128  server_stop($pid_file);
3129
3130  $self->assert_child_ok($pid);
3131
3132  if ($ex) {
3133    test_append_logfile($log_file, $ex);
3134    unlink($log_file);
3135
3136    die($ex);
3137  }
3138
3139  unlink($log_file);
3140}
3141
3142sub sftp_rewrite_homedir {
3143  my $self = shift;
3144  my $tmpdir = $self->{tmpdir};
3145
3146  my $config_file = "$tmpdir/sftp.conf";
3147  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
3148  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
3149
3150  my $log_file = test_get_logfile();
3151
3152  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
3153  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
3154
3155  my $user = 'proftpd';
3156  my $passwd = 'test';
3157  my $group = 'ftpd';
3158  my $home_dir = File::Spec->rel2abs("$tmpdir/$user");
3159  mkpath($home_dir);
3160  my $uid = 500;
3161  my $gid = 500;
3162
3163  my $abs_tmpdir = File::Spec->rel2abs($tmpdir);
3164
3165  # Make sure that, if we're running as root, that the home directory has
3166  # permissions/privs set for the account we create
3167  if ($< == 0) {
3168    unless (chmod(0755, $home_dir)) {
3169      die("Can't set perms on $home_dir to 0755: $!");
3170    }
3171
3172    unless (chown($uid, $gid, $home_dir)) {
3173      die("Can't set owner of $home_dir to $uid/$gid: $!");
3174    }
3175  }
3176
3177  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $abs_tmpdir,
3178    '/bin/bash');
3179  auth_group_write($auth_group_file, $group, $gid, $user);
3180
3181  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
3182  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
3183
3184  my $config = {
3185    PidFile => $pid_file,
3186    ScoreboardFile => $scoreboard_file,
3187    SystemLog => $log_file,
3188    TraceLog => $log_file,
3189    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
3190
3191    AuthUserFile => $auth_user_file,
3192    AuthGroupFile => $auth_group_file,
3193
3194    IfModules => {
3195      'mod_delay.c' => {
3196        DelayEngine => 'off',
3197      },
3198
3199      'mod_rewrite.c' => [
3200        'RewriteEngine on',
3201        "RewriteLog $log_file",
3202        'RewriteHome on',
3203        'RewriteCondition %m REWRITE_HOME',
3204        "RewriteRule ^(.*)\$ \$1/%u",
3205      ],
3206
3207      'mod_sftp.c' => [
3208        "SFTPEngine on",
3209        "SFTPLog $log_file",
3210        "SFTPHostKey $rsa_host_key",
3211        "SFTPHostKey $dsa_host_key",
3212      ],
3213    },
3214  };
3215
3216  my ($port, $config_user, $config_group) = config_write($config_file, $config);
3217
3218  # Open pipes, for use between the parent and child processes.  Specifically,
3219  # the child will indicate when it's done with its test by writing a message
3220  # to the parent.
3221  my ($rfh, $wfh);
3222  unless (pipe($rfh, $wfh)) {
3223    die("Can't open pipe: $!");
3224  }
3225
3226  require Net::SSH2;
3227
3228  my $ex;
3229
3230  # Fork child
3231  $self->handle_sigchld();
3232  defined(my $pid = fork()) or die("Can't fork: $!");
3233  if ($pid) {
3234    eval {
3235      my $ssh2 = Net::SSH2->new();
3236
3237      sleep(1);
3238
3239      unless ($ssh2->connect('127.0.0.1', $port)) {
3240        my ($err_code, $err_name, $err_str) = $ssh2->error();
3241        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
3242      }
3243
3244      unless ($ssh2->auth_password($user, $passwd)) {
3245        my ($err_code, $err_name, $err_str) = $ssh2->error();
3246        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
3247      }
3248
3249      my $sftp = $ssh2->sftp();
3250      unless ($sftp) {
3251        my ($err_code, $err_name, $err_str) = $ssh2->error();
3252        die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str");
3253      }
3254
3255      my $cwd = $sftp->realpath('.');
3256      unless ($cwd) {
3257        my ($err_code, $err_name) = $sftp->error();
3258        die("FXP_REALPATH failed: [$err_name] ($err_code)");
3259      }
3260
3261      $sftp = undef;
3262      $ssh2->disconnect();
3263
3264      my $expected = $home_dir;
3265      if ($^O eq 'darwin') {
3266        # Mac OSX hack
3267        $expected = '/private' . $expected;
3268      }
3269
3270      $self->assert($expected eq $cwd,
3271        test_msg("Expected '$home_dir', got '$cwd'"));
3272    };
3273
3274    if ($@) {
3275      $ex = $@;
3276    }
3277
3278    $wfh->print("done\n");
3279    $wfh->flush();
3280
3281  } else {
3282    eval { server_wait($config_file, $rfh) };
3283    if ($@) {
3284      warn($@);
3285      exit 1;
3286    }
3287
3288    exit 0;
3289  }
3290
3291  # Stop server
3292  server_stop($pid_file);
3293
3294  $self->assert_child_ok($pid);
3295
3296  if ($ex) {
3297    test_append_logfile($log_file, $ex);
3298    unlink($log_file);
3299
3300    die($ex);
3301  }
3302
3303  unlink($log_file);
3304}
3305
3306sub scp_rewrite_upload {
3307  my $self = shift;
3308  my $tmpdir = $self->{tmpdir};
3309
3310  my $config_file = "$tmpdir/sftp.conf";
3311  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
3312  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
3313
3314  my $log_file = test_get_logfile();
3315
3316  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
3317  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
3318
3319  my $user = 'proftpd';
3320  my $passwd = 'test';
3321  my $group = 'ftpd';
3322  my $home_dir = File::Spec->rel2abs($tmpdir);
3323  my $uid = 500;
3324  my $gid = 500;
3325
3326  # Make sure that, if we're running as root, that the home directory has
3327  # permissions/privs set for the account we create
3328  if ($< == 0) {
3329    unless (chmod(0755, $home_dir)) {
3330      die("Can't set perms on $home_dir to 0755: $!");
3331    }
3332
3333    unless (chown($uid, $gid, $home_dir)) {
3334      die("Can't set owner of $home_dir to $uid/$gid: $!");
3335    }
3336  }
3337
3338  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
3339    '/bin/bash');
3340  auth_group_write($auth_group_file, $group, $gid, $user);
3341
3342  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
3343  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
3344
3345  my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt");
3346
3347  my $config = {
3348    PidFile => $pid_file,
3349    ScoreboardFile => $scoreboard_file,
3350    SystemLog => $log_file,
3351    TraceLog => $log_file,
3352    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
3353
3354    AuthUserFile => $auth_user_file,
3355    AuthGroupFile => $auth_group_file,
3356
3357    IfModules => {
3358      'mod_delay.c' => {
3359        DelayEngine => 'off',
3360      },
3361
3362      'mod_rewrite.c' => [
3363        'RewriteEngine on',
3364        "RewriteLog $log_file",
3365
3366        'RewriteMap replace int:replaceall',
3367        'RewriteCondition %m STOR',
3368        'RewriteRule ^(.*)$ "${replace:!$1!&!_}"',
3369      ],
3370
3371      'mod_sftp.c' => [
3372        "SFTPEngine on",
3373        "SFTPLog $log_file",
3374        "SFTPHostKey $rsa_host_key",
3375        "SFTPHostKey $dsa_host_key",
3376      ],
3377    },
3378  };
3379
3380  my ($port, $config_user, $config_group) = config_write($config_file, $config);
3381
3382  # Open pipes, for use between the parent and child processes.  Specifically,
3383  # the child will indicate when it's done with its test by writing a message
3384  # to the parent.
3385  my ($rfh, $wfh);
3386  unless (pipe($rfh, $wfh)) {
3387    die("Can't open pipe: $!");
3388  }
3389
3390  require Net::SSH2;
3391
3392  my $ex;
3393
3394  # Ignore SIGPIPE
3395  local $SIG{PIPE} = sub { };
3396
3397  # Fork child
3398  $self->handle_sigchld();
3399  defined(my $pid = fork()) or die("Can't fork: $!");
3400  if ($pid) {
3401    eval {
3402      my $ssh2 = Net::SSH2->new();
3403
3404      sleep(1);
3405
3406      unless ($ssh2->connect('127.0.0.1', $port)) {
3407        my ($err_code, $err_name, $err_str) = $ssh2->error();
3408        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
3409      }
3410
3411      unless ($ssh2->auth_password($user, $passwd)) {
3412        my ($err_code, $err_name, $err_str) = $ssh2->error();
3413        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
3414      }
3415
3416      my $res = $ssh2->scp_put($config_file, 'test&file.txt');
3417      unless ($res) {
3418        my ($err_code, $err_name, $err_str) = $ssh2->error();
3419        die("Can't upload $config_file to server: [$err_name] ($err_code) $err_str");
3420      }
3421
3422      $ssh2->disconnect();
3423
3424      unless (-f $test_file) {
3425        die("$test_file file does not exist as expected");
3426      }
3427    };
3428
3429    if ($@) {
3430      $ex = $@;
3431    }
3432
3433    $wfh->print("done\n");
3434    $wfh->flush();
3435
3436  } else {
3437    eval { server_wait($config_file, $rfh) };
3438    if ($@) {
3439      warn($@);
3440      exit 1;
3441    }
3442
3443    exit 0;
3444  }
3445
3446  # Stop server
3447  server_stop($pid_file);
3448
3449  $self->assert_child_ok($pid);
3450
3451  if ($ex) {
3452    test_append_logfile($log_file, $ex);
3453    unlink($log_file);
3454
3455    die($ex);
3456  }
3457
3458  unlink($log_file);
3459}
3460
3461sub scp_rewrite_download {
3462  my $self = shift;
3463  my $tmpdir = $self->{tmpdir};
3464
3465  my $config_file = "$tmpdir/sftp.conf";
3466  my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid");
3467  my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard");
3468
3469  my $log_file = test_get_logfile();
3470
3471  my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd");
3472  my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group");
3473
3474  my $user = 'proftpd';
3475  my $passwd = 'test';
3476  my $group = 'ftpd';
3477  my $home_dir = File::Spec->rel2abs($tmpdir);
3478  my $uid = 500;
3479  my $gid = 500;
3480
3481  # Make sure that, if we're running as root, that the home directory has
3482  # permissions/privs set for the account we create
3483  if ($< == 0) {
3484    unless (chmod(0755, $home_dir)) {
3485      die("Can't set perms on $home_dir to 0755: $!");
3486    }
3487
3488    unless (chown($uid, $gid, $home_dir)) {
3489      die("Can't set owner of $home_dir to $uid/$gid: $!");
3490    }
3491  }
3492
3493  auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir,
3494    '/bin/bash');
3495  auth_group_write($auth_group_file, $group, $gid, $user);
3496
3497  my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key');
3498  my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key');
3499
3500  my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt");
3501  if (open(my $fh, "> $test_file")) {
3502    print $fh "Hello, World!\n";
3503    unless (close($fh)) {
3504      die("Can't write $test_file: $!");
3505    }
3506
3507  } else {
3508    die("Can't open $test_file: $!");
3509  }
3510
3511  my $output_file = File::Spec->rel2abs("$tmpdir/retrieved.txt");
3512
3513  my $config = {
3514    PidFile => $pid_file,
3515    ScoreboardFile => $scoreboard_file,
3516    SystemLog => $log_file,
3517    TraceLog => $log_file,
3518    Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20',
3519
3520    AuthUserFile => $auth_user_file,
3521    AuthGroupFile => $auth_group_file,
3522
3523    IfModules => {
3524      'mod_delay.c' => {
3525        DelayEngine => 'off',
3526      },
3527
3528      'mod_rewrite.c' => [
3529        'RewriteEngine on',
3530        "RewriteLog $log_file",
3531
3532        'RewriteMap replace int:replaceall',
3533        'RewriteCondition %m RETR',
3534        'RewriteCondition %F &',
3535        'RewriteRule ^(.*)$ "${replace:!$1!&!_}"',
3536      ],
3537
3538      'mod_sftp.c' => [
3539        "SFTPEngine on",
3540        "SFTPLog $log_file",
3541        "SFTPHostKey $rsa_host_key",
3542        "SFTPHostKey $dsa_host_key",
3543      ],
3544    },
3545  };
3546
3547  my ($port, $config_user, $config_group) = config_write($config_file, $config);
3548
3549  # Open pipes, for use between the parent and child processes.  Specifically,
3550  # the child will indicate when it's done with its test by writing a message
3551  # to the parent.
3552  my ($rfh, $wfh);
3553  unless (pipe($rfh, $wfh)) {
3554    die("Can't open pipe: $!");
3555  }
3556
3557  require Net::SSH2;
3558
3559  my $ex;
3560
3561  # Ignore SIGPIPE
3562  local $SIG{PIPE} = sub { };
3563
3564  # Fork child
3565  $self->handle_sigchld();
3566  defined(my $pid = fork()) or die("Can't fork: $!");
3567  if ($pid) {
3568    eval {
3569      my $ssh2 = Net::SSH2->new();
3570
3571      sleep(1);
3572
3573      unless ($ssh2->connect('127.0.0.1', $port)) {
3574        my ($err_code, $err_name, $err_str) = $ssh2->error();
3575        die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str");
3576      }
3577
3578      unless ($ssh2->auth_password($user, $passwd)) {
3579        my ($err_code, $err_name, $err_str) = $ssh2->error();
3580        die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str");
3581      }
3582
3583      my $res = $ssh2->scp_get('test&file.txt', $output_file);
3584      unless ($res) {
3585        my ($err_code, $err_name, $err_str) = $ssh2->error();
3586        die("Can't download test&file.txt from server: [$err_name] ($err_code) $err_str");
3587      }
3588
3589      $ssh2->disconnect();
3590
3591      unless (-f $output_file) {
3592        die("$output_file file does not exist as expected");
3593      }
3594    };
3595
3596    if ($@) {
3597      $ex = $@;
3598    }
3599
3600    $wfh->print("done\n");
3601    $wfh->flush();
3602
3603  } else {
3604    eval { server_wait($config_file, $rfh) };
3605    if ($@) {
3606      warn($@);
3607      exit 1;
3608    }
3609
3610    exit 0;
3611  }
3612
3613  # Stop server
3614  server_stop($pid_file);
3615
3616  $self->assert_child_ok($pid);
3617
3618  if ($ex) {
3619    test_append_logfile($log_file, $ex);
3620    unlink($log_file);
3621
3622    die($ex);
3623  }
3624
3625  unlink($log_file);
3626}
3627
36281;
3629