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